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件事可能会引起问题，应予以解决：

如果您Dim lastrow, erow As Integer仅erow是Integer，而lastrow是Variant。在VBA中，您需要为每个变量指定一种类型，或者默认为Variant。此外，Excel的行数超出了Integer的处理范围，因此您需要使用Long：
```
Dim lastrow As Long, erow As Long. 
```
此外，我建议使用always to use Long，因为在VB中使用Integer没有好处。
使用.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块时。
您在整个代码中混合了Sheets和Worksheets。确保您知道区别。所有工作表都是工作表，但工作表可以是工作表或图表，也可以是…

因此，请确保使用Worksheets来简化工作表。

我也建议不要一直重复Worksheets("Sheet1")。如果工作表名称从Sheet1更改为MyRawData之类的有用名称，则需要在各处进行更改。更好地定义变量Dim wsData As Worksheet和Set wsData = ThisWorkbook.Worksheets("Sheet1")，然后像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 ####"

的工作表

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

1 个答案:

其他想法