0

背景：クレジットカードの買掛金の追跡に使用されるExcelファイルがあります。18列のデータ（AからR）があります。これらの18列のうち、マクロを使用して特定のステートメントの日付をフィルタリングし、次に特定の会社コードをフィルタリングしたいと思います。

各会社コードには、新しいワークシートが割り当てられます。これらの各ワークシートでは、基準に基づいてマスターワークシートから特定のセルを取得したいと思います。たとえば、マクロは最初にステートメントの日付（7/31/2012）でソートし、次に会社コード（ABC）でソートする必要があります。次に、ループを実行して詳細を表示する必要があります。たとえば、マスターワークシートでは、列PのGLコードを列Hの「ABC」ワークシートにコピーする必要があります。

必要な作業の概要は次のとおり
です。1。フィルター範囲（A2：R2）のフィルターをすべてクリアします
。2。セルA3（日付列）から始まる「マスター」ワークシートのセルA1の日付をフィルターします
。3。会社コードをフィルターします（ ABC）列O

これにより、特定の会社のステートメントアクティビティのデータセットが得られるはずです。次に行う必要があることは次のとおりです
。4。「master」ワークシートの列Pセル値を「ABC」ワークシートの列Cに
コピーします。5。「master」ワークシートの列Nセル値を「ABC」ワークシートの列Dにコピーします。6
。コピー「master」ワークシートの列Rセル値を「ABC」ワークシートの列Hに
コピーします。7。「master」ワークシートの列Fセル値を「ABC」ワークシートの列Gにコピーします。ただし、最大30文字
です。 「master」ワークシートが>=0の場合、その値を「ABC」ワークシートの列Eにコピーします（それ以外の場合はゼロである必要があります）
。9。「master」ワークシートの列Gの値が<0の場合、

これは可能ですか？

4

1 に答える 1

0

これがあなたを始めるためのサブです。すべての手順を実行したわけではありませんが、自分で実行して完了するにはこれで十分だと思います。この回答が必要な場所に到達するのに役立つと思われる場合は、この回答を受け入れてください。ここで何か問題がある場合は、この回答にコメントを追加して説明を求めてください。

ダミーデータでのみテストしましたが、うまくいきました。

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
于 2012-07-28T06:06:54.843 に答える