Question

我目前正在研究费用监控Excel。电子表格有很多工作表，其中包含大量数据。但是为简单起见，假设我只有三个工作表：

第1张-“输入”

第2张-“帐户XX”（简称XX）

第3张-“ YYYY帐户”（简称YY）

想法是费用数据将输入到“输入”表中的某个表中。该表具有“ ACCOUNT”列，用于选择从中进行费用支出的帐户。然后，通过点击宏按钮，费用数据将被转移到相应的其他工作表（XX或YY），具体取决于在“帐户”列中输入的数据。

例如：

费用1（$ 50）-由YY帐户支付

费用2（$ 100）-通过帐户XX进行

费用3（$ 150）-通过帐户YY进行

单击宏按钮时，费用1和费用3将被复制粘贴到工作表“ YY”，而费用2被复制到工作表“ XX”。

我尝试制作一个宏按钮，该按钮应该根据在“ ACCOUNT”列中输入的数据将在“ INPUT”表中输入的数据传输到其他表。我试图将每个费用的“帐户”输入与其他工作表的页眉单元格（例如F1）进行比较，其中包含特定帐户的文本/名称。

例如：

费用1（$ 50）-由帐户YY ≠表格XX单元格F1值：“帐户XX”

费用1（$ 50）-由 YY帐户 =表格YY单元格F1值：“ YY帐户”

因此，请复制到工作表YY。

但是我无法使其工作。当我单击按钮时，没有任何反应。我不知道到底是哪里错了。我尝试研究如何使excel VBA选择将值粘贴到的工作表，但仍无法按预期工作。有什么想法或建议吗？谢谢。

请参阅下面的代码以供参考。

Sub EXPENSES()
Dim nextrow As Long
Dim rowcount As Long
Dim x As Long
For Each Worksheet In Worksheets
    rowcount = Worksheets("INPUT").Range("B19").Value
    For x = 1 To rowcount
        If Worksheet.Range("F1").Value = Worksheets("INPUT").Range("E" & 9 + x - 1).Value Then
        nextrow = Worksheet.Cells(Rows.Count, "G").End(xlUp).Row + 1
        If nextrow < 18 Then nextrow = 18
        Worksheet.Range("B" & nextrow + x - 1).Value = Worksheets("INPUT").Range("B" & 9 + x - 1).Value
        End If
    Next x
Next Worksheet
End Sub

请查看“输入”和“帐户XX”表的屏幕截图。还包括样本数据供您参考。

Input Sheet

Account XX Sheet

此致

Fritze

Answer 1

我对您的代码进行了一些更改。该代码应该可以工作：

Sub EXPENSES()
Dim nextrow As Long
Dim rowcount As Long
Dim x As Long
Dim Worksheet As Object
For Each Worksheet In Worksheets
    rowcount = Worksheets("INPUT").Range("B19").Value
    For x = 1 To rowcount
        If Worksheet.Range("F1").Value = Worksheets("INPUT").Range("E" & 9 + x - 1).Value Then
            nextrow = Worksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
            If nextrow < 18 Then nextrow = 18
            Worksheet.Range("B" & nextrow).Value = Worksheets("INPUT").Range("B" & 9 + x - 1).Value
        End If
    Next x
Next Worksheet
End Sub

或替代性的更快的解决方案：

Sub EXPENSES_Alt()
Dim nextrow As Long
Dim rowcount As Long
Dim x As Long
Dim Worksheet_Name As String
rowcount = Worksheets("INPUT").Range("B19").Value
For x = 1 To rowcount
    Worksheet_Name = Right(Worksheets("INPUT").Range("E" & 8 + x).Value, 2)
    nextrow = Worksheets(Worksheet_Name).Cells(Rows.Count, "B").End(xlUp).Row + 1
    If nextrow < 18 Then nextrow = 18
    Worksheets(Worksheet_Name).Range("B" & nextrow).Value = Worksheets("INPUT").Range("B" & 8 + x).Value
Next x
End Sub

Excel VBA宏可基于其他工作表中的值将粘贴值复制到其他工作表

1 个答案: