vba 比較多個工作表中相同地址的值

Question

我有一個包含大約 100 個工作表的工作簿。

我想比較多個工作表（我的工作簿中的第 5 個到第 100 個工作表）中相同地址（例如 .cell(i,10)）的值。

如果 thisworkbook.sheets(18).cells(i,10).value 在所有工作表中最大，則將 thisworkbook.sheets(18).cells(i,10).value 復制到sheet(1)（其中 i 和 LR 是變量，LR 是 sheet(1) 的最后一行）。

如果特定工作表的 .cells(i,10) 為空白或包含錯誤，則從比較中跳過該工作表的 .cells(i,10)。

我無法獲得所需代碼的正確語法。 有人可以幫忙嗎？

以下是從原始代碼修改為適合 4 個工作表 (5,6,7,8) 的任務：

Dim ws as worksheet, ws5 as worksheet, ws6 as worksheet, ws7 as worksheet, ws8 as worksheet
set ws = thisworkbook.worksheets("MAIN")
set ws5 = thisworkbook.worksheets("five")
set ws6 = thisworkbook.worksheets("six")
set ws7 = thisworkbook.worksheets("seven")
set ws8 = thisworkbook.worksheets("eight")

dim i as long, LR as long
LR = ws.cells(ws.rows.count,1).end(xlup).row

with worksheetfunction
For i = 2 to 5000

if ws5.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws5.cells(i,10).value
end if
if ws6.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws6.cells(i,10).value
end if
if ws7.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws7.cells(i,10).value
end if
if ws8.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws8.cells(i,10).value
end if

next i
end with

end sub

為了跟進蒂姆的解決方案，我發布了我需要的代碼。

Sub Tester()

Dim i As Long, v, mx, r, s, wb As Workbook, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MAIN")

Set wb = ThisWorkbook

For s = 2 To 1000
r = "C" & s

For i = 2 To wb.Worksheets.Count
    v = wb.Worksheets(i).Range(r).Value
    If IsNumeric(v) And Len(v) > 0 Then
        mx = IIf(Len(mx) = 0, v, IIf(v > mx, v, mx))
    End If
Next i

ws.Cells(s, 1).Value = IIf(Len(mx) > 0, mx, "No values")

Debug.Print IIf(Len(mx) > 0, mx, "No values")
mx = False

Next s
End Sub

Answer 1

您可以使用循環：

Sub Tester()
    
    Dim i As Long, v, mx, r, wb As Workbook
    
    Set wb = ThisWorkbook
    r = "A1"
   
    For i = 2 To wb.Worksheets.Count
        v = wb.Worksheets(i).Range(r).Value
        If IsNumeric(v) And Len(v) > 0 Then
            mx = IIf(Len(mx) = 0, v, IIf(v > mx, v, mx))
        End If
    Next i
    
    Debug.Print IIf(Len(mx) > 0, mx, "No values")

End Sub

Answer 2

Sub Tester()

Dim i As Long, v, mx, r, s, wb As Workbook, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MAIN")

Set wb = ThisWorkbook

For s = 2 To 1000
r = "C" & s

For i = 2 To wb.Worksheets.Count
v = wb.Worksheets(i).Range(r).Value
If IsNumeric(v) And Len(v) > 0 Then
    mx = IIf(Len(mx) = 0, v, IIf(v > mx, v, mx))
End If
Next i

ws.Cells(s, 1).Value = IIf(Len(mx) > 0, mx, "No values")

Debug.Print IIf(Len(mx) > 0, mx, "No values")
mx = False

Next s
End Sub