将数据循环并复制到新工作表

3 回答

• 0

  以下将满足您的期望：

  Sub foo()
  Dim ws As Worksheet: Set ws = Sheets("Sheet1")
  'declare and set your worksheet, amend as required
  Dim wsResult As Worksheet: Set wsResult = Sheets("Sheet2")
  LastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
  'get the last row with data on Column J
  
  For i = 2 To LastRow
      NextRow = wsResult.Cells(wsResult.Rows.Count, "D").End(xlUp).Row + 1
      ws.Range("H" & i & ":J" & i).Copy Destination:=wsResult.Range("D" & NextRow)
      wsResult.Range("A" & NextRow).Value = "Title"
      If ws.Cells(i, 1) <> "" Then 'if GroupID is not empty
          wsResult.Range("B" & NextRow).Value = ws.Cells(i, 1) 'grab that GroupID
      Else
          x = i
          Do While Trim(ws.Cells(x, 1)) = ""
              x = x - 1
              Group = ws.Cells(x, 1) 'get the GroupID of the Row above
          Loop
          wsResult.Range("B" & NextRow).Value = Group
      End If
  
      For y = 2 To 7
          If ws.Cells(i, y) <> "" Then
              Level = ws.Cells(1, y).Value
              Exit For
          End If
      Next y
      wsResult.Cells(NextRow, 3) = Level
  Next i
  End Sub
  

  回复于 2024-04-20T23:07:44+08:00
• 1

  试试这个：

  Sub BuildTable()
      Dim data(), i As Integer, j As Integer
  
      data = Worksheets("Sheet1").Range("A2:J5").Value
  
      For i = 1 To UBound(data)
          With Worksheets("Sheet2")
              .Range("A" & i) = "Title"
              .Range("D" & i) = data(i, 8)
              .Range("E" & i) = data(i, 9)
              .Range("F" & i) = data(i, 10)
  
              If i > 1 Then
                  .Range("B" & i) = IIf(data(i, 1) <> "", data(i, 1), .Range("B" & i - 1))
              Else
                  .Range("B" & i) = data(i, 1)
              End If
  
              For j = 2 To 7
                  If data(i, j) = "x" Then
                      .Range("C" & i) = "Level" & j - 1
                  End If
              Next j
  
          End With
      Next i 
  End Sub
  

  回复于 2024-04-20T23:07:44+08:00
• 0

  您可以使用 Power Query Excel 2010轻松下载和激活，或者在2016版本中默认激活 . 在那里，您可以转换数据并将其作为表或数据透视表：

  

  回复于 2024-04-20T23:07:44+08:00