複数のワークシートで範囲を設定する

Question

5つの同じワークシート（名前は10,20,30,40,50）があり、それらを個別のファイル（名前：csv）にコピーしたいとします。まず、セルの値が<> ""と0の場合は、すべてのワークシートでマクロを検索する必要があります（すべて5と同じです）。

さらに、条件が満たされる。残念ながら私は自分が望む値を得られません。

誰かが私の間違いを見つけられますか？

興味があります：コードは、ソースとして機能しているワークシートが1つしかない場合にはうまく機能しました。したがって、範囲を変更/調整する必要があると思います。 は、残念ながら私の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 

「私は合理的な方法で列を表示するために、他のフォーラムからコピーした機能を見つけることができません

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