如何遍历单元格列并写入另一列单元格

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

我立即看到的 3 件事可能会导致问题并且应该修复：

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

    Dim lastrow As Long, erow As Long.

   此外，我建议始终使用 Long，因为在 VB 中使用Integer没有任何好处。

2. 停止使用.Activate和.Select 。 这是一种非常糟糕的做法，会导致许多错误。 请参阅如何避免在 Excel VBA 中使用 Select 。 始终直接引用您的工作簿和工作表。 确保所有Cells 、 Range 、 Rows和Columns对象都有对工作表的引用。 有一些没有像Cells(I, 3)应该更改为类似Sheets("Sheet1").Cells(I, 3)或使用 With 块到.Cells(I, 3) 。

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

   因此，请确保将Worksheets用于工作表会更干净。

   我还建议不要一直重复Worksheets("Sheet1") 。 如果您的工作表名称从Sheet1更改为MyRawData有用MyRawData ，则需要在任何地方更改它。 最好定义一个变量Dim wsData As Worksheet并Set wsData = ThisWorkbook.Worksheets("Sheet1")然后你可以像wsData.Range("A1")…一样使用它wsData.Range("A1")…

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

代码的干净版本可能如下所示：

Option Explicit 'make sure you use it in every module as first line to force proper variable declaration

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).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

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

你越接近一个好的格式和一个好的编码风格，你得到的错误就越少。 即使它看起来有时需要更多的工作，但最终您将节省大量时间而不用去寻找奇怪的问题。

---

进一步的想法

这条线

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

看起来您需要再次深入研究代码 2021 并添加"Water 2021"因为您的代码停止工作。

避免编写需要每年调整的代码。 我的建议是遍历所有工作表并检查它们的名称是否与"Water ####"匹配以在它们上运行代码：

Dim Asset As Worksheet
For Each Asset In ThisWorkbook.Worksheets
    If Asset.Name Like "Water ####" Then
        'your code here …
    End If
End If

这会将代码应用于每个名为"Water ####"工作表