4

私は次のようなマクロを作成しようとしています。

  1. テーブルを通過します
  2. そのテーブルの列Bの値に特定の値があるかどうかを調べます
  3. ある場合は、その行を他のワークシートの範囲にコピーします

結果はテーブルのフィルタリングに似ていますが、行を非表示にしないようにします

私はvbaに少し慣れていないので、どこから始めればよいのかよくわかりません。助けていただければ幸いです。

4

4 に答える 4

6

それはまさに高度なフィルターで行うことです。ワン ショットの場合は、マクロも必要ありません。[データ] メニューで利用できます。

Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _
    , Unique:=False
于 2012-08-29T19:44:11.877 に答える
2

選択は遅く、必要ありません。次のコードははるかに高速になります。

Sub CopyRowsAcross() 
Dim i As Integer 
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1") 
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2") 

For i = 2 To ws1.Range("B65536").End(xlUp).Row 
    If ws1.Cells(i, 2) = "Your Critera" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1) 
Next i 
End Sub
于 2012-08-29T19:18:12.060 に答える
2

次のようにしてみてください。

Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long

endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1

For r = 1 To endRow 'Loop through sheet1 and search for your criteria

    If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found

            'Copy the current row
            Rows(r).Select 
            Selection.Copy

            'Switch to the sheet where you want to paste it & paste
            Sheets("Sheet2").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndex = pasteRowIndex + 1


           'Switch back to your table & continue to search for your criteria
            Sheets("Sheet1").Select  
    End If
Next r
End Sub
于 2012-08-29T12:00:23.410 に答える
0

あなたは、VBA を使用するのではなく、VLOOKUP 関数を使用して解決しようとする問題について説明しています。

常に最初に非 vba ソリューションを検討する必要があります。

VLOOKUP (または、ドイツ語で SVERWEIS) のいくつかのアプリケーション例を次に示します。

http://www.youtube.com/watch?v=RCLUM0UMLXo

http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx

マクロとして作成する必要がある場合は、VLOOKUP をアプリケーション関数として使用できます (パフォーマンスが遅くても簡単な解決策です)。そうしないと、同様の関数を自分で作成する必要があります。

後者でなければならない場合は、パフォーマンスの問題に関して、仕様の詳細が必要です。

任意の範囲を配列にコピーし、この配列をループして値を確認してから、この値を他の範囲にコピーできます。これは、これをvba関数として解決する方法です。

これは次のようになります。

Public Sub CopyFilter()

  Dim wks As Worksheet
  Dim avarTemp() As Variant
  'go through each worksheet
  For Each wks In ThisWorkbook.Worksheets
        avarTemp = wks.UsedRange
        For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
          'check in the first column in each row
          If avarTemp(i, LBound(avarTemp, 2)) = "XYZ" Then
            'copy cell
             targetWks.Cells(1, 1) = avarTemp(i, LBound(avarTemp, 2))
          End If
        Next i
  Next wks
End Sub

わかりました、今、私は自分にとって便利な素晴らしいものを持っています:

Public Function FILTER(ByRef rng As Range, ByRef lngIndex As Long) As Variant
  Dim avarTemp() As Variant
  Dim avarResult() As Variant
  Dim i As Long
  avarTemp = rng

  ReDim avarResult(0)

  For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
      If avarTemp(i, 1) = "active" Then
        avarResult(UBound(avarResult)) = avarTemp(i, lngIndex)
        'expand our result array
        ReDim Preserve avarResult(UBound(avarResult) + 1)
      End If
  Next i

  FILTER = avarResult
End Function

この =FILTER(Tabelle1!A:C;2) または =INDEX(FILTER(Tabelle1!A:C;2);3) のようにワークシートで使用して、結果行を指定できます。誰かがこれを拡張して、インデックス機能を FILTER に含めるか、オブジェクトのような範囲を返す方法を知っていると確信しています-おそらく私もできましたが、今日はできません;）

于 2012-08-29T12:07:13.140 に答える