Question

我有5个相同的工作表（名称：10,20,30,40,50），并希望将它们复制到一个单独的文件中（名称：csv）。首先，我定义了范围（对于所有5个都是相同的），并且宏应该在所有工作表中搜索，如果单元格值＆lt;＆gt; ＆＃34;＆＃34;和0。

此外，如果满足条件，我想复制更多值。不幸的是，我没有得到我想要的价值。

有人能发现我的错误吗？

感兴趣：当只有一个工作表作为源时，代码工作得很好，所以我想我可以更改/调整范围。不幸的是我的VBA仍然非常差，我无法找到解决方案

Sub Sample()

    Dim i As Integer
    Dim j As Integer
    Dim resultrange As Range
    Dim row As Range

    Dim sheetsArray As Sheets
    Set sheetsArray = ActiveWorkbook.Sheets(Array("10", "20", "30", "40", "50"))
    Dim target As Range
    Dim sheetObject As Worksheet

    For Each sheetObject In sheetsArray
        Set target = sheetObject.Range("H6:T529")
    Next sheetObject


    Dim cell As Range

    Set resultrange = Sheets("CSV").Range("C2:T1000")


    i = 1
    For Each cell In target
        If (cell.value <> "" And cell.value <> 0) Then
            resultrange.Rows.Cells(i, 5).value = cell.value
            resultrange.Rows.Cells(i, 17).value = Range("A" & cell.row).value
            resultrange.Rows.Cells(i, 18).value = Range(Col_Letter(cell.column) & "2").value
            resultrange.Rows.Cells(i, 2).value = Range(Col_Letter(cell.column) & "1").value

            i = i + 1
        End If
    Next cell




End Sub

＆＃39;我从其他论坛复制的功能，以合理的方式显示列

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

Answer 1

您需要嵌套循环。这段代码......

For Each sheetObject In sheetsArray
Set target = sheetObject.Range("H6:T529")
Next sheetObject

...对target范围不执行任何操作，因此当该循环退出时，您只会复制其设置的最后Range。

Dim cell As Range
Set ResultRange = Sheets("CSV").Range("C2:T1000")
i = 1
For Each sheetObject In sheetsArray
    Set target = sheetObject.Range("H6:T529")
    For Each cell In target
        With target.Worksheet
            If (cell.Value <> "" And cell.Value <> 0) Then
                ResultRange.Rows.Cells(i, 5).Value = cell.Value
                ResultRange.Rows.Cells(i, 17).Value = .Cells(cell.Row, 1).Value
                ResultRange.Rows.Cells(i, 18).Value = .Cells(2, cell.Column).Value
                ResultRange.Rows.Cells(i, 2).Value = .Cells(1, cell.Column).Value
                i = i + 1
            End If
        End With
    Next cell
Next sheetObject

通过多个工作表设置范围

1 个答案: