如何循环通过一列单元格并写入另一列单元格

Question

在我的工作簿中，我有几列数据表，并且我将两列连接数据写入目标表，这很好。我的问题是，然后我遍历日期的第一列，并尝试在第3列中写出日期名称（对于数据透视表）。写入前50个左右的单元（1240个单元）后，代码将挂起。 for循环包含似乎表明某种变量溢出的问题。这是我的代码：

Sub copycolumn()
Dim lastrow, erow As Integer
Dim I As Long
Dim data As String
Dim Assets As Variant
Dim Asset As Variant

With Sheets("Sheet1") 'Clear the existing sheet rows
 lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
 .Range(.Cells(2, 1), .Cells(lastrow, 1)).ClearContents
 .Range(.Cells(2, 2), .Cells(lastrow, 1)).ClearContents
 .Range(.Cells(2, 3), .Cells(lastrow, 1)).ClearContents
End With

Assets = Array("Water 2016", "Water 2017", "Water 2018", "Water 2019", "Water 2020")

For Each Asset In Assets   'copy each sheet's 2 col data to "sheet1" into 1 long column
 With Sheets(Asset)
 lastrow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row)
 .Range(.Cells(2, 1), .Cells(lastrow, 1)).Copy 'date
 erow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
 Worksheets("Sheet1").Range("A" & erow).PasteSpecial xlPasteValues

 .Range(.Cells(2, 4), .Cells(lastrow, 4)).Copy 'data
 erow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
 Worksheets("Sheet1").Range("B" & erow).PasteSpecial xlPasteValues
End With
Next Asset

'goto sheet1 and put day name into column 4
Sheets("Sheet1").Activate 
lastrow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row
For I = 2 To lastrow 'DeS' hangs in this loop
  Cells(I, 3) = Format(Cells(I, 1), "dddd")
Next
Cells(lastrow, 4).Select

MsgBox "Copied" & vbTab & lastrow & vbTab & "Rows"
End Sub

我要去哪里错了？似乎这样应该很简单。

Answer 1

我立即看到的三件事可能会引起问题，应予以解决：

1. 如果您只有Dim lastrow, erow As Integer，则erow为Integer，但lastrow为Variant。在VBA中，您需要为every变量指定类型，或者默认为Variant。此外，Excel的行数超过了Integer不能处理的行，因此您需要使用Long：

   Dim lastrow As Long, erow As Long. 
   

   此外，我推荐使用always to use Long，因为在VB中使用Integer没有任何好处。

2. 使用.Activate和.Select停止。这是非常糟糕的做法，并导致许多错误。参见How to avoid using Select in Excel VBA。始终直接参考您的工作簿和工作表。确保所有Cells，Range，Rows和Columns对象都具有对图纸的引用。有些不像Cells(I, 3)的东西应该更改为像Sheets("Sheet1").Cells(I, 3)的东西，或者当对.Cells(I, 3)使用With块时。

3. 您在整个代码中混合了Sheets和Worksheets。确保您知道区别。所有工作表都是工作表，但是工作表可以是工作表或图表，也可以是…

   因此请确保将Worksheets用于工作表会更清洁。

   我也建议不要一直重复Worksheets("Sheet1")。如果工作表名称从Sheet1更改为类似MyRawData的有用名称，则需要在各处进行更改。更好地定义变量Dim wsData As Worksheet和Set wsData = ThisWorkbook.Worksheets("Sheet1")，然后可以像wsData.Range("A1")…

一样使用它

[尝试修复这些问题，并检查是否仍然卡在代码中。如果这样不能解决您的问题，请将问题中的代码编辑为更新的代码。尝试找出导致问题的原因，并告诉我们原因。

干净的代码版本可能看起来像：

Option Explicit

Public Sub CopyColumn()
    Dim wsData As Worksheet 'name your sheet only once and set a reference using a variable
    Set wsData = ThisWorkbook.Worksheets("Sheet1")

    With wsData 'Clear the existing sheet rows
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        'the other 2 ClearContents are already covered by this one and therefore are not needed
        .Range(.Cells(2, 3), .Cells(LastRow, 1)).ClearContents
    End With

    Dim Assets As Variant
    Assets = Array("Water 2016", "Water 2017", "Water 2018", "Water 2019", "Water 2020")

    Dim Asset As Variant
    For Each Asset In Assets   'copy each sheet's 2 col data to "sheet1" into 1 long column
        With ThisWorkbook.Worksheets(Asset)
            LastRow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row)
            .Range(.Cells(2, 1), .Cells(LastRow, 1)).Copy 'date

            Dim eRow As Long
            eRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            wsData.Range("A" & eRow).PasteSpecial xlPasteValues

            .Range(.Cells(2, 4), .Cells(LastRow, 4)).Copy 'data
            eRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Offset(1, 0).Row
            wsData.Range("B" & eRow).PasteSpecial xlPasteValues
        End With
    Next Asset

    'goto sheet1 and put day name into column 4
    LastRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Offset(0, 0).Row

    Dim i As Long
    For i = 2 To LastRow 'DeS' hangs in this loop
        wsData.Cells(i, 3).Value = Format$(wsData.Cells(i, 1), "dddd")
    Next i

    'jump to the last row
    wsData.Activate
    wsData.Cells(LastRow, 4).Select 'not needed if you don't want explicitly the user to see this

    MsgBox "Copied" & vbTab & LastRow & vbTab & "Rows", vbInformation, "Copy Rows"
End Sub

请注意，我没有深入研究代码的作用。我只是检查了编码样式，并修复了明显可能出错的语法。

您越接近遵循良好的格式和良好的编码样式，将得到的错误越少。即使有时看起来需要更多工作，但最终您将节省大量时间，不必为奇怪的问题而忙碌。