如何将记录迁移到另一个excel工作表中的特定单元格并追加结果

owfi6suc 于 2023-06-07 发布在其他

关注(0)|答案(1)|浏览(112)

我给你举一个明显的例子。假设我们在输入工作表中有4行（从第2行到第5行），那么在新工作表中的输出应该是这样的：

A2 ->w3 and CY6
B2 ->G2
C2->AI4
D2->CH5
E2->AE4
G2->DA6
H2->CQ6

A3 ->w8 and CY11
B3 ->G7
C3->AI9
D3->CH10
E3->AE9
G3->DA11
H3->CQ11

and 

A4 ->w13 and CY16
B4 ->G12
C4->AI14
D4->CH15
E4->AE14
G4->DA16
H4->CQ16

again 

A5->w18 and CY21
B5 ->G17
C5->AI19
D5->CH20
E5->AE19
G5->DA21
H5->CQ21

并且对于下一行再次执行相同的逻辑
我设法做到这一点的一行，但我不设法自动和追加的结果正确。
我需要使用宏/vba，因为这个过程需要做900次...
下面是我的VBA代码：

' Get the last row in the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row

' Migrate the data row by row
For targetRow = 2 To lastRow
        With targetSheet
        .Cells((targetRow - 1) * 4, 23).Value = sourceSheet.Cells(targetRow, 1).Value ' Migrate column A to target column W3
        .Cells(((targetRow - 1) * 4) + 3, 99).Value = sourceSheet.Cells(targetRow, 1).Value ' Migrate column A to target column CY6
        .Cells(((targetRow - 1) * 4) + 1, 7).Value = sourceSheet.Cells(targetRow, 2).Value ' Migrate column B to target column G2
        .Cells(((targetRow - 1) * 4) + 2, 35).Value = sourceSheet.Cells(targetRow, 3).Value ' Migrate column C to target column AI4
        .Cells(((targetRow - 1) * 4) + 3, 31).Value = sourceSheet.Cells(targetRow, 4).Value ' Migrate column D to target column CH5
        .Cells(((targetRow - 1) * 4) + 2, 31).Value = sourceSheet.Cells(targetRow, 5).Value ' Migrate column E to target column AE4
        .Cells(((targetRow - 1) * 4) + 3, 106).Value = sourceSheet.Cells(targetRow, 7).Value ' Migrate column G to target column DA6
        .Cells(((targetRow - 1) * 4) + 1, 93).Value = sourceSheet.Cells(targetRow, 8).Value ' Migrate column H to target column CQ6
    End With
    Next targetRow

亲切的问候
雨果

excel

来源：https://stackoverflow.com/questions/76370799/how-to-migrate-records-to-specific-cells-in-another-excel-sheet-and-append-the-r

1条答案

按热度按时间

rryofs0p1#

试试这样的东西：

Sub Tester()
    
    Dim arrMaps, wsSrc As Worksheet, wsDest As Worksheet, rw As Range, i As Long
    Dim v, arr, lr as Long
    
    'array of cell mappings
    arrMaps = Array("A1>W3", "A1>CY6", "B1>G2", "C1>AI4") 'etc etc
    
    Set wsSrc = Worksheets("source")
    Set wsDest = Worksheets("destination")
    i = 0
    'loop data rows
    lr = wsSrc.Cells(Rows.Count, "A").End(xlUp).Row
    For Each rw In wsSrc.Range("A2:H" & lr).Rows
        For Each v In arrMaps   'loop over mappings
            arr = Split(v, ">")
            'note `arr(0)` is *relative* to range `rw`
            wsDest.Range(arr(1)).Offset(5 * i).Value = rw.Range(arr(0)).Value
        Next v
        i = i + 1 'increment destination offset
    Next rw
End Sub

赞(0）回复(0）举报 2023-06-07

我来回答

如何将记录迁移到另一个excel工作表中的特定单元格并追加结果

1条答案

相关问题

热门标签

最新问答