Question

背景：我有一个用于跟踪信用卡应付款的Excel文件。有18列数据（A到R）。在这18列中，我想使用宏来过滤特定的陈述日期，然后过滤特定的公司代码。

将为每个公司代码分配一个新的工作表。在每个工作表中，我想根据条件从主工作表中提取特定单元格。例如，宏应首先排序语句日期（7/31/2012），然后排序公司代码（ABC）。然后，我需要运行一个循环来引入细节。例如，在主工作表中，P列中的GL代码需要复制到＆＃34; ABC＆＃34; H栏中的工作表。

以下是需要发生的事情摘要：
1.清除过滤器范围内的所有过滤器（A2：R2）
2.过滤单元格A1上的日期＆＃34; Master＆＃34;从单元格A3（日期列）开始的工作表
3.在O列中过滤公司代码（ABC）

这应该为特定公司的声明活动提供数据集。以下是需要发生的事情：
4.在＆＃34; master＆＃34;中复制Column P单元格值。工作表到C＃C＆C; ABC＆＃34;工作表
5.在＆＃34; master＆＃34;中复制N列单元格值。工作表到＆＃34; ABC＆＃34;工作表
6.在＆＃34; master＆＃34;中复制Column R单元格值。工作表到＆＃34; ABC＆＃34;工作表
7.在＆＃34; master＆＃34;中复制列F单元格值工作表到＃G;＆＃34; ABC＆＃34;工作表，但最多30个字符
8.如果＆＃34;主＆＃34;中的列G值工作表是＆gt; = 0，然后将该值复制到＆＃34; ABC＆＃34;中的E列;工作表（否则需要为零）
9.如果＆＃34;主＆＃34;中的列G值工作表是＆lt; 0，然后将该值复制到＆＃34; ABC＆＃34;中的列F工作表（否则需要为零）

这可能吗？

Answer 1

这是一个应该让你开始的潜艇。我没有实施你所有的步骤，但我相信这足以让你自己完成。如果您发现此答案有助于您到达目的地，请接受此答案。如果您在此处遇到任何问题，请在此答案中添加注释，要求澄清。

我只测试了虚拟数据，但我所做的工作是成功的。

Option Explicit

Sub TransferData()
Dim Master As Worksheet
Dim NewSheet As Worksheet
Dim CompanyList As Object
Dim lRow As Long, lMaxRow As Long, lNewRow As Long
Dim vDictItem As Variant

Set CompanyList = CreateObject("Scripting.Dictionary")

Set Master = ThisWorkbook.Sheets("Master")

If Master.FilterMode Then
    Master.ShowAllData
End If

Master.Range("A:R").Sort Master.Range("A2"), xlAscending, Master.Range("O2"), , xlAscending, , , xlYes

lMaxRow = Master.Range("A" & Master.Rows.Count).End(xlUp).Row
For lRow = 3 To lMaxRow
    If Not CompanyList.Exists(Master.Range("A" & lRow).Value) Then
        CompanyList.Add Master.Range("A" & lRow).Value, Master.Range("A" & lRow).Value
    End If
Next lRow

For Each vDictItem In CompanyList.Keys
    Master.Range("A3:R" & lMaxRow).AutoFilter 1, vDictItem
    If Master.Cells.SpecialCells(xlCellTypeVisible).Count > 0 Then
        Set NewSheet = ThisWorkbook.Worksheets.Add
        NewSheet.Name = vDictItem
        lNewRow = 1
        For lRow = 3 To lMaxRow
            If Master.Rows(lRow).Hidden = False Then
                lNewRow = lNewRow + 1
                NewSheet.Range("C1").Value = Master.Range("P1").Value
                NewSheet.Range("C" & lNewRow).Value = Master.Range("P" & lRow).Value
                NewSheet.Range("G1").Value = Master.Range("F1").Value
                NewSheet.Range("G" & lNewRow).Value = Left(Master.Range("F" & lRow).Value, 30)
                NewSheet.Range("E1").Value = Master.Range("G1").Value & " (POS)"
                NewSheet.Range("F1").Value = Master.Range("G1").Value & " (NEG)"
                If Master.Range("G" & lRow).Value >= 0 Then
                    NewSheet.Range("E" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
                Else
                    NewSheet.Range("F" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
                End If
            End If
        Next lRow
    End If
Next vDictItem


End Sub

根据多个条件复制同一行中的多个单元格

1 个答案: