I'm assuming you have no problem opening the file(s) desired despite the overly long name.....
There are several ways to do formulas
Sub DoFormulasSAS()
Dim i As Long
'=IF(B2="","",SUMPRODUCT((ISNUBER(SEARCH($B2,Source!$A$3:$A$200)))*1))
'converting the spreadsheet formula to vba and leaving the value only
For i = 2 To 9
Cells(i, "e").Value = Evaluate("=IF(c" & i & "="""","""",SUMPRODUCT((ISNUMBER(SEARCH(B" & i & ",Source!$A$3:$A$200)))*1))")
Next i
With Range("d2:d40")
.Formula = "=IF(c2="""","""",SUMPRODUCT((ISNUMBER(SEARCH($c2,Source!$A$3:$A$200)))*1))"
'.Value = .Value
End With
End Sub
=======
Also you need to remove selections,, However, use above ideas. If all else fails, send me the file with explanations and examples.
Range("I2").FormulaR1C1 = "=RC[-1]^2"
Range("I2").Copy Range("I3:I" & LastRow1)
'--------------------
Don Guillett
Microsoft Excel Developer
SalesAid Software
dguillett1@gmail.com
From: edo rs
Sent: Tuesday, October 23, 2012 11:48 PM
To: ExcelVBA@yahoogroups.com
Subject: [ExcelVBA] RSQ calculation using VBA
Dear Excel VBA experts,
I had tried to modified a vba script for processing my multiple xls files. I wish I can get enlightenment through this forum.
My multiple xls files has different amount of row. The example of file as below :
A B C D E F G H
-12 114 3 0.2 1 0.1 0.4 0.5
-13 112 4 0.6 1 0.1 0.4 0.8
I would like to square of H and put the results on I. So the expected output is :
A B C D E F G H I
-12 114 3 0.2 1 0.1 0.4 0.5 0.25
-13 112 4 0.6 1 0.1 0.4 0.8 0.64
The next step, I would like to calculate Rsquare using formula RSQ=(I2:I3,D2:D3), and put the RSQ results on cell J2. I had tried to modified a vba script, but the result is not good as expected. Below is my modified script:
Dim strDocPath As String
Dim strCurrentFile As String
Dim Fname As String
Application.ScreenUpdating = False
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long
LastRow1 = Range("I3").End(xlDown).Row
LastRow2 = Range("I2").End(xlDown).Row
LastRow3 = Range("D2").End(xlDown).Row
Set vX = Range("I2:I" & LastRow2)
Set vY = Range("D2:D" & LastRow3)
strDocPath = "D:\workfolder\hycom_be_daily\se_project\exploration_t_s_u\be_se2004_2006_19oct2012\be_se2007_validation\tes\"
'strCurrentFile = Dir(strDocPath & "*.*")
strCurrentFile = Dir(strDocPath & "*.xls")
Do While strCurrentFile <> ""
Workbooks.Open Filename:=strDocPath & strCurrentFile
Range("I2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]^2"
Range("I2").Select
Selection.Copy
Range("I3:I" & LastRow1).Select
ActiveSheet.Paste
Range("J2").Select
Application.CutCopyMode = False
'ActiveCell.FormulaR1C1 = "=RSQ(vX, vY)"
Application.WorksheetFunction.RSq(vX, vY)
ActiveWorkbook.Save
ActiveWorkbook.Close
strCurrentFile = Dir
Loop
Application.ScreenUpdating = True
Your help is really appreciated
Regards
Ed
[Non-text portions of this message have been removed]
[Non-text portions of this message have been removed]
| Reply via web post | Reply to sender | Reply to group | Start a New Topic | Messages in this topic (2) |
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar