[發問] sheet1 & Sheet2 欄位比對，如何變成整行列比對執行

迷糊小書僮

Sheet1 & Sheet2 的 單一欄位可以做比對，如果要把整格欄位跑完的迴圈，怎麼編譯會比較好，想破頭中...

code as below:

Sub 按鈕1_Click()
Dim Number As String

If Worksheets(1).Range("B2").Value = Worksheets(2).Range("B2") Then
Number = Worksheets(2).Range("P2").Value
Select Case Number
    Case Is = "Passed"
        Worksheets(1).Range("P2").Value = "Passed"
        Worksheets(1).Range("Q2").Value = Sheets(2).Range("Q2").Value
        Worksheets(1).Range("V2").Value = Sheets(2).Range("V2").Value
    Case Is = "Failed"
        Worksheets(1).Range("P2").Value = "Failed"
        Worksheets(1).Range("Q2").Value = Sheets(2).Range("Q2").Value
        Worksheets(1).Range("V2").Value = Sheets(2).Range("V2").Value
    Case Is = "Blocked"
        Worksheets(1).Range("P2").Value = "Blocked"
        Worksheets(1).Range("Q2").Value = Sheets(2).Range("Q2").Value
        Worksheets(1).Range("V2").Value = Sheets(2).Range("V2").Value
    Case Is = "Exempted"
        Worksheets(1).Range("P2").Value = "Exempted"
        Worksheets(1).Range("Q2").Value = Sheets(2).Range("Q2").Value
        Worksheets(1).Range("V2").Value = Sheets(2).Range("V2").Value
    End Select


MsgBox "finished"

End If

End Sub

迷糊小書僮

回復 1# 迷糊小書僮

導入 For loop
但是Range("B2")=>裡面的("B2")可以用變數取代嗎?利用i在+1變成自動加行列去處理嗎?

For i = 2 To 5000
a = "P" & i
If Worksheets(1).Range("B2").Value = Worksheets(2).Range("B2") Then
    Worksheets(1).Range("B & i").Vaule Worksheets(2).Range("B & i") ??

Number = Worksheets(2).Range("P2").Value

迷糊小書僮

回復 2# 迷糊小書僮

for loop 已解出

For i = 2 To 2000
a = "P" & i
b = "Q" & i
c = "V" & i
d = "B" & i
If Worksheets(1).Range(d).Value = Worksheets(2).Range(d) Then

Number = Worksheets(2).Range(a).Value
Select Case Number
    Case Is = "Passed"
        Worksheets(1).Range(a).Value = "Passed"
        Worksheets(1).Range(b).Value = Sheets(2).Range(b).Value
        Worksheets(1).Range(c).Value = Sheets(2).Range(c).Value
    Case Is = "Failed"
        Worksheets(1).Range(a).Value = "Failed"
        Worksheets(1).Range(b).Value = Sheets(2).Range(b).Value
        Worksheets(1).Range(c).Value = Sheets(2).Range(c).Value
    Case Is = "Blocked"
        Worksheets(1).Range(a).Value = "Blocked"
        Worksheets(1).Range(b).Value = Sheets(2).Range(b).Value
        Worksheets(1).Range(c).Value = Sheets(2).Range(c).Value
    Case Is = "Exempted"
        Worksheets(1).Range(a).Value = "Exempted"
        Worksheets(1).Range(b).Value = Sheets(2).Range(b).Value
        Worksheets(1).Range(c).Value = Sheets(2).Range(c).Value
        
    End Select

迷糊小書僮

請問加入了資料夾建置判斷式，導致"執行時間錯誤5"這個問題，是哪邊流程出了狀況呢?
If Len(Dir(sPath & "Result", vbDirectory)) = 0 Then
    MkDir sPath & "Result"
End If

完整code
b = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
sPath = "C:\Users\Desktop\daliy report  demo test_1\"
  sFile = Dir(sPath & "\*.xlsx")   
Do While sFile <> ""
Workbooks.Open sPath & "\" & sFile, UpdateLinks:=0
               
   If i <> 1 Then
   'If Len(Dir(sPath & "Result", vbDirectory)) = 0 Then
    MkDir sPath & "Result"
  ' End If
    Sheets(1).Copy
    ActiveWorkbook.SaveAs sPath & "Result" & "\" & Format(Date, "mmdd") & "Result.xlsx"
    i = 1   '第一次開啟
    Workbooks(sFile).Close
   
  Else
    Sheets(1).Copy After:=Workbooks(Format(Date, "mmdd") & "Result.xlsx").Sheets(1)
    Worksheets(2).Name = "Sheet2"
    Call compare
    Worksheets(2).Delete
    Workbooks(sFile).Close
   
  End If
    sFile = Dir()
  Loop
   
  Workbooks(Format(Date, "mmdd") & "Result.xlsx").Close SaveChanges:=True