Question

我需要帮助，我有2张纸，在第一张纸上我记录了不同数字（1到50）的时间，我想将时间戳复制到相同数字的新纸张上。表1： Sheet 1 example

请帮助您使用VBA代码自动完成此操作。

Sub mytry()
Dim lRow As Long
Dim lRow1 As Long
Dim time1 As Date

Sheets("Time").Select

lRow = Range("A" & Rows.Count).End(xlUp).Row

For iCntr = 2 To lRow

num1 = Cells(iCntr, 1)

    Sheets("Rec").Select
    lRow1 = Range("A" & Rows.Count).End(xlUp).Row
    For iCntr2 = 2 To lRow1
        If Cells(iCntr2, 1) = num1 Then
            time1 = Cells(iCntr2, 2)
            Sheets("Time").Select
            For t1 = 2 To 20
            If Cells(iCntr, t1) = "" Then
            Cells(iCntr, t1) = time1
            End If
            GoTo 1

            Next t1
             1
            Sheets("Rec").Select

        End If


    Next iCntr2

Sheets("Time").Select
Next iCntr

End Sub

Answer 1

这不是我做过的最漂亮的事情，但我会尝试......

您可能想要考虑添加一些变量，因为您知道某些项目将在Sheets（“Rec”）上的位置：

Dim i as integer
Dim lRow as Long 'Specific to Sheets("Time")
Dim LC1 as Long, LC2 as Long, LC3 as Long 'Up to LC9 in the example for Last Column for Row #

拿走你所拥有的并滚动它，循环通过表格（“时间”）：

lRow = Sheets("Time").Range("A" & Sheets("Time").Rows.Count).End(xlUp).Row

For i = 2 to lRow

我建议在开始时避免使用工作表选择，并按照名称指定工作表，或使用With语句（后者可能无法顺利使用Select Case的路径）。

然后，您可以在循环内部使用与您的数字计数相当的Select Case，例如，示例中的9。

Select Case Cells(i,1).Value

Case 1
   LC1=Sheets("Rec").Cells(2, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(2,LC1)

Case 2
   LC2=Sheets("Rec").Cells(3, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(3,LC2)

Case 3
   LC3=Sheets("Rec").Cells(4, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(4,LC3)

End Select

然后你应该可以让它运行得非常顺利，确保Next i。这一切看起来像：

Dim i as integer
Dim lRow as Long 
Dim LC1 as Long, LC2 as Long, LC3 as Long 

lRow1 = Sheets("Time").Range("A" & Sheets("Time").Rows.Count).End(xlUp).Row

For i = 2 to lRow

Select Case Cells(i,1).Value

Case 1
   LC1=Sheets("Rec").Cells(2, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(2,LC1)

Case 2
   LC2=Sheets("Rec").Cells(3, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(3,LC2)

Case 3
   LC3=Sheets("Rec").Cells(4, Sheets("Rec").Columns.Count).End(xlToLeft).Column 
   Sheets("Time").Cells(i,2).Copy Sheets("Rec").Cells(4,LC3)

End Select

Next i

VBA - 将特定值从一个工作表列复制到下一个工作表行

1 个答案: