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

22 浏览
0 Comments

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

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

每个公司代码将被分配一个新的工作表。在每个工作表中，我想根据条件从主工作表中带入特定的单元格。例如，宏应该首先按对账日期（2012年7月31日）排序，然后按公司代码（ABC）排序。然后，我需要运行一个循环来带入详细信息。例如，在主工作表中，列P中的总账代码需要复制到“ABC”工作表的列H中。

以下是需要执行的摘要：

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的值小于0，则将该值复制到“ABC”工作表的列F中（否则应为零）。

这是否可行？

0

1 答案

0 Comments

最近我遇到了一个问题，需要根据多个条件从同一行中复制多个单元格。下面是一个子程序，可以帮助你开始解决这个问题。我没有实现所有的步骤，但我相信这已经足够让你自己完成了。

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

我认为这个程序可以工作，但是我遇到了一个"overflow"错误，并且指向了代码"If Master.Cells.SpecialCells(xlCellTypeVisible).Count > 0 Then"，似乎它没有过滤出任何特定的内容。

这可能与这个问题(点击查看评论)有关。不幸的是，我还没有足够的了解来解释为什么会出现这个错误，因为我没有遇到这个错误。

请参考这个问题，我认为它最好地解释了overflow错误的原因！

0