Vba 基于多个条件复制同一行中的多个单元格

Vba 基于多个条件复制同一行中的多个单元格,vba,excel,Vba,Excel,背景:我有一个Excel文件用于跟踪信用卡应付款。共有18列数据(A到R)。在这18列中,我想使用宏来筛选特定的报表日期,然后再筛选特定的公司代码 每个公司代码将分配一个新的工作表。在每个工作表中,我希望根据标准从主工作表中引入特定的单元格。例如,宏应首先按报表日期(2012年7月31日)排序,然后按公司代码(ABC)排序。然后,我需要运行一个循环来带来细节。例如,在主工作表中,P列中的总账代码需要复制到H列中的“ABC”工作表中 以下是需要发生的事情的摘要: 1.清除过滤器范围内的所有过滤器(

背景:我有一个Excel文件用于跟踪信用卡应付款。共有18列数据(A到R)。在这18列中,我想使用宏来筛选特定的报表日期,然后再筛选特定的公司代码

每个公司代码将分配一个新的工作表。在每个工作表中,我希望根据标准从主工作表中引入特定的单元格。例如,宏应首先按报表日期(2012年7月31日)排序,然后按公司代码(ABC)排序。然后,我需要运行一个循环来带来细节。例如,在主工作表中,P列中的总账代码需要复制到H列中的“ABC”工作表中

以下是需要发生的事情的摘要:
1.清除过滤器范围内的所有过滤器(A2:R2)
2.从单元格A3(日期列)开始,在“主”工作表的单元格A1中筛选日期
3.O列中公司代码(ABC)的过滤器

这应该为特定公司的报表活动提供一个数据集。接下来需要做的是:
4.将“主”工作表中的P列单元格值复制到“ABC”工作表中的C列
5.将“主”工作表中的N列单元格值复制到“ABC”工作表中的D列
6.将“主”工作表中的R列单元格值复制到“ABC”工作表中的H列
7.将“主”工作表中的F列单元格值复制到“ABC”工作表中的G列,但最多30个字符
8.如果“主”工作表中的G列值>=0,则将该值复制到“ABC”工作表中的E列(否则需要为零)

9如果“主”工作表中的G列值为,那么这里有一个子项可以帮助您开始。我没有实施你的所有步骤,但我相信这足以让你自己采取并完成。如果你觉得这个答案有助于你到达你需要去的地方,请接受这个答案。如果您在这里有任何问题,请在此回答中添加评论,要求澄清

我只对虚拟数据进行了测试,但我所做的工作是成功的

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-3吗?要回答上一条评论中的问题,请使用
ActiveSheet.Cells.SpecialCells(xlCellTypeVisible)。选择
仅获取未过滤的单元格。一般来说,如果您已经创建了任何代码,请将其添加到问题主体中,以便我们可以更直接地指导您。如果到目前为止您还没有任何代码,我或其他人可能可以为您生成这样的函数,但您可能需要自己进行一些修改/调整。我不信任我的任何代码!(这也是基于代码主体内的手动输入)。如果你能给我指出正确的方向,我一定会根据需要修改。再次感谢您在这方面的反馈和帮助。我愿意提供帮助,但需要一些时间为您完成这项工作。除非有人先找到它,否则我将尝试在接下来的24-48小时内找到一些东西。我认为这会起作用,但我遇到了一个“溢出”错误,它将我指向代码“If Master.Cells.SpecialCells(xlCellTypeVisible.Count>0”――很遗憾,它似乎没有过滤任何特别的东西,我还没有对此进行足够的研究来解释为什么会发生这种情况,因为我自己没有得到错误。@user1556069请查看,因为我认为它最好地解释了溢出错误的原因!