0

Excelワークシートでセルのフィールド（テーブル）を選択し、選択範囲を切り取って、新しい別のシートに貼り付ける必要があります。このワークシートには何千ものテーブルがあり、それらを自動的に切り取って別のシートに貼り付けたいと思います。表は＃記号が入ったセルで区切られていますが、それが何らかの形で役立つかどうかはわかりません。最初のテーブルにこのマクロを記録すると、次のように実行されます。

Sub Makro1()
Range("A2:AB20").Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
End Sub

次に、ワークシート全体を通過するループを作成し、列Aの＃記号で区切られるすべてのテーブルを動的に選択して、新しいシートに貼り付けます。正確な範囲A2：AB20を選択したくありませんが、この＃記号に従って選択したいと思います。

これがスクリーンショットです ここに画像の説明を入力してください

4

2 に答える 2

1

これにより、すべてのハッシュ値のインデックスが配列に入力されます。これにより、適切なデータを収集するために必要な参照ポイントが提供されます。

Sub FindHashmarksInColumnA()

    Dim c As Range
    Dim indices() As Long
    Dim i As Long
    Dim iMax As Double
    Dim ws As Worksheet

    Set ws = ActiveSheet

    i = 0
    iMax = Application.WorksheetFunction.CountIf(ws.Range("A:A"), "#")
    ReDim indices(1 To iMax)

    For Each c In ws.UsedRange.Columns(1).Cells
        If c.Value = "#" Then
            i = i + 1
            indices(i) = c.Row
        End If
    Next c

    ' For each index,
    ' Count rows in table,
    ' Copy data offset from reference of hashmark,
    ' Paste onto new sheet in appropriate location etc.

End Sub
于 2013-02-25T13:14:22.080 に答える
0

このコードを試してください。必要に応じて上位4つの定数を調整する必要がある場合があります。

Sub CopyToSheets()
    Const cStrSourceSheet As String = "tabulky"
    Const cStrStartAddress As String = "A2"
    Const cStrSheetNamePrefix As String = "Result"
    Const cStrDivider As String = "#"

    Dim rngSource As Range
    Dim lngMaxRow As Long, lngLastDividerRow As Long, lngRowCount As Long
    Dim wsTarget As Worksheet
    Dim lngCounter As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Delete old worksheets
    Application.DisplayAlerts = False
    For Each wsTarget In Sheets
        If InStr(wsTarget.Name, cStrSheetNamePrefix) Then wsTarget.Delete
    Next
    Application.DisplayAlerts = True

    With Sheets(cStrSourceSheet)
        Set rngSource = .Range(cStrStartAddress)
        lngLastDividerRow = rngSource.Row
        lngMaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
    End With

    Set rngSource = rngSource.Offset(1)
    While rngSource.Row < lngMaxRow
        If rngSource = cStrDivider Then
            lngCounter = lngCounter + 1
            Set wsTarget = Sheets.Add(After:=Sheets(Sheets.Count))
            wsTarget.Name = cStrSheetNamePrefix & " " & lngCounter
            lngRowCount = rngSource.Row - lngLastDividerRow - 1
            rngSource.Offset(-lngRowCount - 1).Resize(lngRowCount).EntireRow.Copy _
                wsTarget.Range("A1").Resize(lngRowCount).EntireRow

            lngLastDividerRow = rngSource.Row
        End If
        Set rngSource = rngSource.Offset(1)
    Wend

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub
于 2013-02-25T13:31:59.360 に答える