Excel VBA - 为什么我的单元格值没有被追加？

Question

我目前有一个脚本（见下文），它将使用过的行中每个单元格的内容添加到另一个工作表中的另一个单元格。但是，这适用于前3个单元格，但由于某种原因不适用于最后2个单元格。

Sub Ready_For_Infra()
Dim i As Integer
Dim k As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Worksheets("InfraData")
Set ws2 = Worksheets("ActionPlan")

ws1.Cells.Clear

For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row Step 1
    For k = 1 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
        With Worksheets("InfraData")
            If ws2.Cells(k, i).Value <> "" Then
            ws1.Range("A" & i).Value = ws1.Range("A" & i).Value & ws2.Cells(i, k).Value & Chr(10)
            End If
        End With
    Next k
Next i

MsgBox "Done"



End Sub

这是ws2（ActionPlan）中的数据，以防它有所帮助：

为了澄清，它似乎没有将细胞D2：F3附加到我要求它的细胞上。有人能够建议为什么会出现这种情况吗？

Answer 1

试试这段代码：

Sub Ready_For_Infra()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cell As Range
    Dim i As Long, lastrow As Long, lastcol As Long
    Dim str1 As String

    Set ws1 = Worksheets("InfraData")
    Set ws2 = Worksheets("ActionPlan")

    ws1.Cells.Clear

    With ws2
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 2 To lastrow
            str1 = ""
            For Each cell In .Range(.Cells(i, 1), .Cells(i, lastcol))
                If cell.Value <> "" Then str1 = str1 & cell.Value & Chr(10)
            Next cell
            ws1.Range("A" & i).Value = str1
        Next i
    End With

    MsgBox "Done"
End Sub

注意：

1. 使用For each循环比For k=1 To lastcol
稍快一些
2. 使用临时字符串变量str1也可以使代码更快，因为在这种情况下，您只在ws1.Range("A" & i)单元格中写入结果值一次（使用操作内存总是比在单元格中写入子结构更快）每次迭代）。