Dear Ed
I can see that you did not test this because it requires nLastRow to be dimensioned.
When this is corrected LastRow1 gets the last row of the spreadsheet (using your two rows example), instead of the last row of your data rectangle which you already have in nLastRow.
I also have to point out that you get nLastRow before you loop through the folder so nLastRow does not apply to the current open file and does not change as you loop round.
Regards
Derek Turner
+++
>________________________________
> From: edo rs <edoido_modis@yahoo.com>
>To: ExcelVBA@yahoogroups.com
>Sent: Thursday, 25 October 2012, 4:08
>Subject: Re: [ExcelVBA] RSQ calculation using VBA
>
>
>
>Dear Don Guillet, David Smart and Derek Turner,
>
>Thank you very much for your ideas, its really helpfull.
>
>Based on your suggestions, finally, I could figure my code, and it's work for my xls data. The modified code is as follow :
>
>Dim strDocPath As String
>Dim strCurrentFile As String
>Dim Fname As String
>Application.ScreenUpdating = False
>Dim LastRow1 As Long
>Dim LastRow As Long,sFormula As String
>LastRow1 = Range("I3").End(xlDown).Row
>nLastRow = Range("I2").End(xlDown).Row
>
>strDocPath = "D:\workfolder\hycom_be_daily\se_project\exploration_t_s_u\be_se2004_2006_19oct2012\be_se2007_validation\tes\"
>strCurrentFile = Dir(strDocPath & "*.xls")
>
>Do While strCurrentFile <> ""
>Workbooks.Open Filename:=strDocPath & strCurrentFile
>Range("I2").FormulaR1C1 = "=RC[-1]^2"
>Range("I2").Copy Range("I3:I" & LastRow1)
>
>sFormula = "=RSQ(i2:i" & nLastRow & ",d2:d" & nLastRow & ")"
>Debug.Print sFormula
>Range("j2").Formula = sFormula
>
>ActiveWorkbook.Save
>ActiveWorkbook.Close
>strCurrentFile = Dir
>Loop
>
>
>Application.ScreenUpdating = True
>
>ActiveWorkbook.Save
>ActiveWorkbook.Close
>strCurrentFile = Dir
>Loop
>Application.ScreenUpdating = True
>
>Indeed, I still use two kind of lastrow. First lastrow for copy cell I2 and paste to I3 until lastrow of I, and another lastrow was used for RSQ formula.
>
>Regards
>Ed
>
>--- On Wed, 10/24/12, Derek Turner <g4swy@yahoo.com> wrote:
>
>From: Derek Turner <g4swy@yahoo.com>
>Subject: Re: [ExcelVBA] RSQ calculation using VBA
>To: "ExcelVBA@yahoogroups.com" <ExcelVBA@yahoogroups.com>
>Date: Wednesday, October 24, 2012, 12:51 PM
>
>
>
>Dear Ed
>
>Addressing only the RSQ formula :-
>
>Dim nLastRow As Long, sFormula As String
>
>nLastRow = Range("I2").End(xlDown).Row
>
>sFormula = "=RSQ(i2:i" & nLastRow & ",d2:d" & nLastRow & ")"
>
>Debug.Print sFormula
>
>Range("j2").Formula = sFormula
>
>Note how you use the Debug.Print to view the formula in the Immediate window.
>
>Why three Lastrows in your code ?
>
>Regards
>
>Derek Turner
>
>+++
>
>>________________________________
>
>> From: dguillett1 <dguillett1@gmail.com>
>
>>To: ExcelVBA@yahoogroups.com
>
>>Sent: Wednesday, 24 October 2012, 13:24
>
>>Subject: Re: [ExcelVBA] RSQ calculation using VBA
>
>>
>
>>
>
>>
>
>>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]
>
>>
>
>>
>
>>
>
>>
>
>>
>
>[Non-text portions of this message have been removed]
>
>[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 (6) |
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