excel复制许多列中的数据

时间:2017-05-11 01:22:56

标签: vba excel-vba excel

我有这个Excel宏:

Sub test()
     Dim LR As Long, i As Long, buf
     LR = Cells(Rows.Count, 2).End(xlUp).Row
     For i = 3 To LR
     If Cells(i, 25).Value <> "" Then
     buf = Cells(i, 25).Value
     Else
     Cells(i, 25).Value = buf
     End If
     Next
End Sub

这有助于我在DAT 1栏中执行此操作:

ID      LABEL   DAT 1   DAT 2   DAT 3   DAT 4   DAT 5   DAT 6   DAT 7
1330102 10171   12:02   12:08   13:00   14:24   14:40   15:30   16:28
1329807 9598    11:57   12:20   13:05   14:10   14:22   15:02   15:35
1329807 9598    11:57                       
1329807 9598    11:57                       
1331864 9608    15:49   16:02   16:12   17:13   17:25   18:56   19:14
1329708 9608    15:49                       
5001021 98327   13:30   13:22   13:32   14:09   14:19   14:54   15:13
1307566 98327   13:30                       
1306925 98327   13:30                       
1307574 98327   13:30   

我需要这样做:(在多个列和行中复制相同的值)。 DAT 2,DAT 3,DAT 4,DAT 5,DAT 6,DAT 7.

ID      LABEL   DAT 1   DAT 2   DAT 3   DAT 4   DAT 5   DAT 6   DAT 7
1330102 10171   12:02   12:08   13:00   14:24   14:40   15:30   16:28
1329807 9598    11:57   12:20   13:05   14:10   14:22   15:02   15:35
1329807 9598    11:57   12:20   13:05   14:10   14:22   15:02   15:35       
1329807 9598    11:57   12:20   13:05   14:10   14:22   15:02   15:35
1331864 9608    15:49   16:02   16:12   17:13   17:25   18:56   19:14
1329708 9608    15:49   16:02   16:12   17:13   17:25   18:56   19:14       
5001021 98327   13:30   13:22   13:32   14:09   14:19   14:54   15:13
1307566 98327   13:30   13:22   13:32   14:09   14:19   14:54   15:13
1306925 98327   13:30   13:22   13:32   14:09   14:19   14:54   15:13
1307574 98327   13:30   13:22   13:32   14:09   14:19   14:54   15:13   

实施解决方案的任何想法......?

1 个答案:

答案 0 :(得分:0)

遍历列,并循环遍历该循环中的行?

Sub test()
    Dim LR As Long, i As Long
    Dim LC As Long
    Dim c As Long
    LR = Cells(Rows.Count, 2).End(xlUp).Row
    LC = Cells(2, Columns.Count).End(xlToLeft).Column ' Assuming row 2 is your headers
    For c = 25 To LC  ' Assuming that column Y is first column to be processed
        For i = 3 To LR
            If Cells(i, c).Value = "" Then
                Cells(i, c).Value = Cells(i - 1, c).Value
            End If
        Next
    Next
End Sub