0

特定の列 (G) の各行の値に基づいてリストを生成する方法に取り組んでいます。現在、リストは行全体をコピーでき、完全に機能します。列 G に必要なテキスト (「カード」) が含まれている場合はすべての行を取り出し、別のスプレッドシートのリストに隙間なく配置します。

問題は、行全体ではなく、「カード」を含む各行のいくつかの列からの情報のみをリストに含めることです。

マクロで列 "A"、"G"、および "ET" からのみ情報を取得する方法はありますか?

私が現在使用しているコードは以下のとおりです。

'----Alonso Approved List Generator----'
Sub AlonsoApprovedList()
  Dim cell As Range
  Dim NewRange As Range
  Dim MyCount As Long
  Dim ExistCount As Long
  ExistCount = 0
  MyCount = 1
'----For every cell in row G on the ESI Project Data sheet----'
  For Each cell In Worksheets("ESI Project Data").Range("G6:G5000")
  If cell.Value = "Card" Then
      ExistCount = ExistCount + 1
      If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)
      '----Sets up a new range to copy all data from the row if column G in that row contains the value in question----'
      Set NewRange = Application.Union(NewRange, cell.EntireRow)
      MyCount = MyCount + 1
  End If
  Next cell
  If ExistCount > 0 Then
      NewRange.Copy Destination:=Worksheets("Alonso Approved List").Range("A3")
  End If
End Sub

つまり、上記のコードを変更して、あるワークシートからデータを取得し、「セル」範囲と特定の列から行番号を指定して別のワークシートにリストを生成したいと考えています。

列 G のドロップダウン データ検証リストには、次の項目のいずれかが含まれています。

カード 住宅ローン 自動車小売業 商業投資顧問 債権回収業務 情報技術 地域社会問題 人事マーケティング 不動産経営 財務 リスク クレジットソーシング スタッフ管理 RCC

それは可能ですか？

タイトルで使用する列を決定するために、一致関数のようなものを使用できれば、非常に便利です。

明確にするために、このスプレッドシートは複数の異なるユーザーによって定期的に更新されるため、情報は静的ではありません. 行は頻繁に追加および変更され、場合によっては削除されます。そのため、セルの値を元のシートから新しいリストにコピーすることはできません。

質問への回答:

  1. 列 G ドロップダウン データ検証リストには、1 つの複数の項目が含まれています。完全なリストは別のワークシートにあります。ユーザーは各項目に移動し、特定のカテゴリから選択します。
  2. 問題の他の列には、項目の名前、カテゴリ (列 G と同じ)、金額、および日付が含まれています。
  3. 会社情報が多いので、データをアップロードするのをためらっています。私の目標は、マクロで複数のセルを同じ行から別のシートに自動的にコピーすることです。正しい行のループと検出は既に行われています。基本的に、「cell.EntireRow」(行全体をコピー)をそのセルのいくつかの選択行に置き換える方法はありますか?
4

1 に答える 1

0

私は戻ってきて、この質問を答えで更新したいと思いました。少し遅れていますが、回答済みの質問は、永続的に未解決の質問よりも優れています...

Sub ApprovedList()

Dim cell As Range
Dim rngDest As Range
Dim i As Long
Dim arrColsToCopy

    arrColsToCopy = Array(1, 3, 4, 5)
    '----For every cell in row G on the ESI Project Data sheet----'
    Set rngDest = Worksheets("Alonso Approved List").Range("A3")

    Application.ScreenUpdating = False

    For Each cell In Worksheets("ESI Project Data").Range("G6:G5000").Cells

        If cell.Value = "Card" Then

            For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngDest.Offset(0, i)
                End With
            Next i

            Set rngDest = rngDest.Offset(1, 0) 'next destination row

        End If

    Next cell

    Application.ScreenUpdating = True

End Sub
于 2014-01-04T19:53:41.407 に答える