0

85,000行のExcelファイルがあり、セルのコメントだけを抽出する必要がありますが、現在は大きすぎるため、VB（これまでに行ったことがない）やマクロ、または各行を通過する何かを書くことができるかどうか疑問に思っています、セルのコメントがある列があるかどうかを確認し、ない場合は行を削除します。

これを達成する方法についてのヒントをいただければ幸いです。私はプログラミングのバックグラウンドを持っています (そして、何年も前に VB2-6 をいくつかやりましたが、Excel 用にプログラミングしたことはありません)。

4

2 に答える 2

2

これはあなたが求めていたものとは少し異なりますが、私はあなたのニーズを満たしていると思います。コメントのある行を選択して貼り付け、行1の想定されるヘッダーを別のシートに貼り付けます。「Sheet1」を次のように変更します。

Sub PasteRowsWithComments()
Dim wsSource As Excel.Worksheet
Dim wsTarget As Excel.Worksheet
Dim RowsWithComments As Excel.Range

Set wsSource = Sheet1
Set wsTarget = Worksheets.Add
On Error Resume Next
Set RowsWithComments = wsSource.Cells.SpecialCells(xlCellTypeComments).EntireRow
On Error GoTo 0
If Not RowsWithComments Is Nothing Then
    RowsWithComments.Copy Destination:=wsTarget.Range("A1")
    wsSource.Range("A1").EntireRow.Copy
    wsTarget.Range("A1").Insert shift:=xlDown
End If
End Sub

ファローアップ

Option Explicit

Dim RngToCopy As Range

Sub PasteRowsWithComments()
    Dim wsSource As Excel.Worksheet
    Dim wsTarget As Excel.Worksheet
    Dim RowsWithComments As Excel.Range

    Set wsSource = Sheet1: Set wsTarget = Worksheets.Add

    On Error Resume Next
    Set RowsWithComments = wsSource.Cells.SpecialCells(xlCellTypeComments).EntireRow
    On Error GoTo 0

    If Not RowsWithComments Is Nothing Then
        '~~> This is required to clean duplicate ranges so that we do not get
        '~~> the error "That command cannot be used on multiple selections"
        If InStr(1, RowsWithComments.Address, ",") Then _
        Set RngToCopy = cleanRange(RowsWithComments) Else _
        Set RngToCopy = RowsWithComments

        RngToCopy.Copy Destination:=wsTarget.Rows(1)
        wsSource.Range("A1").EntireRow.Copy
        wsTarget.Range("A1").Insert shift:=xlDown
    End If
End Sub

'~~> This function will convert `$1:$1,$1:$1,$4:$4,$7:$7` to `$1:$1,$4:$4,$7:$7`
Function cleanRange(rng As Range) As Range
    Dim col As New Collection
    Dim Myarray() As String, sh As String, tmp As String
    Dim i As Long
    Dim itm As Variant

    sh = rng.Parent.Name: Myarray = Split(rng.Address, ",")

    For i = 0 To UBound(Myarray)
        On Error Resume Next
        col.Add Myarray(i), """" & Myarray(i) & """"
        On Error GoTo 0
    Next i

    For Each itm In col
        tmp = tmp & "," & itm
    Next

    tmp = Mid(tmp, 2): Set cleanRange = Sheets(sh).Range(tmp)
End Function
于 2012-08-08T22:39:31.260 に答える