根据多个条件复制同一行中的多个单元格 [英] Copying multiple cells in same row based on multiple criteria

问题描述

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

每个公司代码将被分配一个新的工作表。在每个这些工作表中，我想根据标准从主工作表中引出特定的单元格。例如，宏应首先排序报表日期（7/31/2012），然后是公司代码（ABC）。然后，我需要运行一个循环来带来细节。例如，在主工作表中，列P中的GL代码需要复制到第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，则将该值复制到列E在ABC工作表中（否则需要为零）

9.如果主工作表中的列G值为< 0，则将该值复制到ABC工作表中的列F需要为零）

这是可能吗？

解决方案

一个子，应该让你开始。我没有执行所有的步骤，但我相信这足以自行完成。如果你发现这个答案有助于你到达你需要去的地方，请接受这个答案。如果你在这里遇到任何问题，请给这个答案添加评论，要求澄清。

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

  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）
 
设置Master = ThisWorkbook.Sheets（Master）
 
如果Master.FilterMode然后
 Master.ShowAllData 
结束如果
 
 Master.Range（A：R）。排序Master.Range（A2），xlAscending，Master.Range（O2），xlAscending，，，xlYes 
 
 lMaxRow = Master.Range（A& Master.Rows.Count）.End（xlUp）.Row 
对于lRow = 3 To lMaxRow 
如果不是CompanyList.Exists（Master .Range（A& lRow）.Value）然后
 CompanyList.Add Master.Range（A& lRow）.Val ue，Master.Range（A& lRow）.Value 
 End If 
 Next lRow 
 
对于每个vDictItem在CompanyList.Keys 
 Master.Range（A3：R& lMaxRow）.AutoFilter 1，vDictItem 
如果Master.Cells.SpecialCells（xlCellTypeVisible）.Count> 0然后
设置NewSheet = ThisWorkbook.Worksheets.Add 
 NewSheet.Name = vDictItem 
 lNewRow = 1 
对于lRow = 3到lMaxRow 
如果Master.Rows（lRow ）.Hidden = False然后
 lNewRow = lNewRow + 1 
 NewSheet.Range（C1）。Value = Master.Range（P1）。value 
 NewSheet.Range & lNewRow）.Value = Master.Range（P& lRow）.Value 
 NewSheet.Range（G1）Value = Master.Range（F1）值
 NewSheet.Range（G& lNewRow）.Value = Left（Master.Range（F& lRow）.Value，30）
 NewSheet.Range（E1）。Value = Master.Range （G1）。 （POS）
 NewSheet.Range（F1）。Value = Master.Range（G1）。 （NEG）
如果Master.Range（G& lRow）.Value> = 0然后
 NewSheet.Range（E& lNewRow）.Value = Left（Master。范围（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 
  

Background: I have an Excel file used for tracking credit card payables. There are 18 columns of data (A through R). Out of these 18 columns, I want to use a macro to filter for specific statement date and then for a specific company code.

Each company code will be assigned a new worksheet. In each of these worksheets, I want to bring over specific cells from the master worksheet based on the criteria. For instance, the macro should first sort for statement date (7/31/2012) and then company code (ABC). Then, I need to run a loop to bring over details. For instance, in the master worksheet, the GL code in column P needs to be copied to the "ABC" worksheet in column H.

Here's a summary of what needs to happen:
1. Clear any filters in filter range (A2:R2)
2. Filter for date in cell A1 on "Master" worksheet beginning in cell A3 (date column)
3. Filter for company code (ABC) in column O

That should give a data set for particular company's statement activity. Here's what needs to happen next:
4. Copy Column P cell values in "master" worksheet to Column C in "ABC" worksheet
5. Copy Column N cell values in "master" worksheet to Column D in "ABC" worksheet
6. Copy Column R cell values in "master" worksheet to Column H in "ABC" worksheet
7. Copy Column F cell values in "master" worksheet to Column G in "ABC" worksheet, but max of 30 characters
8. If Column G value in "master" worksheet is >=0, then copy that value to Column E in "ABC" worksheet (otherwise needs to be zero)
9. If column G value in "master" worksheet is <0, then copy that value to Column F in "ABC" worksheet (otherwise needs to be zero)

Is this possible?

解决方案

Here's a sub that should get you started. I did not implement all your steps, but I believe this is enough to take and finish on your own. If you find this answer is helpful to get you where you need to go, please accept this answer. If you have problems with anything here, please add a comment to this answer asking for clarification.

I have only tested on dummy data, but what I did work with was successful.

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

这篇关于根据多个条件复制同一行中的多个单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！