vba - Excel VBA: コンパイラエラー

Question

それで昨日、私は最初の SO の質問を投稿しました。しかし、私は自分自身を持ち上げ、ほこりを払いました。うまくいけば、この質問はより受け入れられるでしょう... :-)

監視する必要がある健康アンケートのリストからデータの重複を削除しようとしていますが、苦労していたトリッキーなビットは、1 つの列で重複を見つけてから、隣接する 3 つの列について同じ行のデータを確認することでした。も重複していました。検索された「重複した行」を保存することは、私をうんざりさせていたビットでした。

以下は、同様に機能する他のスクリプトからいくつかのコードを組み合わせたものです。現在、デバッグモードに入っていますが、エラーが発生し続けています... VBA の経験があまりないため、オプションが不足しています。

g現在、変数とで型の不一致エラーが発生していますfirstAddress。なぜこれらが問題を引き起こしているのですか???

電話firstAddress.Rowしてもいいですか、それとも間違った木を吠えていますか?

スニペットは次のとおりです。

g = .Find(Range("G" & i).Text, LookIn:=xlValues)
            If Not g Is Nothing Then
                firstAddress = g.Address
                dupRow = firstAddress.Row

そして、これが以下のコード全体です。どんな助けでも大歓迎です！

Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Integer
Dim firstAddress As Integer


'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range

'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range

'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)

Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lw 'Find duplicates from the list.
    If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then

    'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
    With Worksheets("Still In Progress").rngFirst
        g = .Find(Range("G" & i).Text, LookIn:=xlValues)
        If Not g Is Nothing Then
            firstAddress = g.Address
            dupRow = firstAddress.Row
            If Range("H" & dupRow).Text = Range("H" & i).Text _
            And Range("I" & dupRow).Text = Range("I" & i).Text _
            And Range("J" & dupRow).Text = Range("J" & i).Text Then

        'select the entire row
        Range.EntireRow.Select

        'copy the selection
        Selection.Cut

        'Now identify and select the new sheet to paste into
        Set objNewSheet = ThisWorkbook.Worksheets("Completed")
        objNewSheet.Select

        'Looking at your initial question, I believe you are trying to find the next     available row
        Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)

        Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
        ActiveSheet.Paste

        'delete the initial row
        rngCell.EntireRow.Delete

        Set g = .FindNext(g)
            Loop While Not g Is Nothing And g.Address <> firstAddress
        End If
    End With
Next i
End Sub

score 0 · Accepted Answer

私はあなたのコードを注意深く調べました。いくつかの問題がありました。これらのいくつかは、私が修正できたと思います。定義したことのない範囲を削除しているため、何をしようとしていたかを説明する必要があります...

最初の問題は次の行にあります。

If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then

CountIf関数は数値を返します。この数値を文字列「Complete」と比較しています。この行を超えることはできないと思うので、残りのコード (正しいかどうかにかかわらず) は実行されません。行がいつ「完了」とマークされるかわからないため、この行で何をしようとしているのか完全には明確ではありませんが、セルにA & i文字列「その中で「完了」なら、あなたはおそらくやりたいと思うでしょう

If Range("A" & i).Text = "Complete" Then

一致するで適切に終了していない、、、および構造がIf - Then多数Withありました。私はこれを修正しようとしました - 私がそれを正しくしたことを確認してください. 適切なインデントを使用すると、このような問題を見つけるのに本当に役立つことに注意してください。スペースバーはあなたの友達です...LoopEnd

Findメソッドはオブジェクトを返すため、関数を使用する正しい方法は次のとおりです。

Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)

それとは別に-Option Explicitコードの先頭で使用し、可能な限り最も制限的な（正しい）型で変数を定義します。これを行ったとき、修正できないエラーが見つかりました-rngCell宣言も設定もされていない変数で...それがどれほど役立つかを示しています。タイプミスを見つけるのにも適しています - VBA は喜んで次のようなものを書くことができます

myVar = 1 MsgBox myVra + 1

タイプミスのため、メッセージは1ではなくになります...オプションでさえあるべきである2という事実は、VBA チームが行った多くの不可解な設計上の決定の 1 つです。Explicit

これが「ほとんどのエラーが修正された」コードです。少なくともこのようにコンパイルされますが、残りのエラーをどうするかを理解する必要があります (「Complete」とマークされたセルで何をしたかったかについて、私が正しく推測したかどうかはわかりません)。

コメント歓迎。

Option Explicit

Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Range
Dim firstAddress As Range

'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range

'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range

'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)

Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lw 'Find duplicates from the list.
'  If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
   If Range("A" & i).Text = "Complete" Then
   'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
    With Worksheets("Still In Progress").rngFirst
      Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)
        If Not g Is Nothing Then
          firstAddress = g.Address
          dupRow = firstAddress.Row
          If Range("H" & dupRow).Text = Range("H" & i).Text _
            And Range("I" & dupRow).Text = Range("I" & i).Text _
            And Range("J" & dupRow).Text = Range("J" & i).Text Then

            'select the entire row
            g.EntireRow.Select

            'copy the selection
            Selection.Cut

            'Now identify and select the new sheet to paste into
            Set objNewSheet = ThisWorkbook.Worksheets("Completed")
            objNewSheet.Select

            'Looking at your initial question, I believe you are trying to find the next     available row
            Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)

            Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
            ActiveSheet.Paste

            'delete the initial row
            rngCell.EntireRow.Delete  ' <<<<<< the variable rngCell was never defined. Cannot guess what you wanted to do here!

            Do
              Set g = .FindNext(g)
              Loop While Not g Is Nothing And g.Address <> firstAddress

          End If ' entire row matched
        End If   ' Not g Is Nothing
      End With   ' With Worksheets("Still in Progress")
    End If       ' CountIf = "Complete"

  Next i

End Sub

別の便利なトリック: で行っているように「次の使用可能な行に貼り付ける」場合Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select、通常、代わりに次のようなことを行うと便利です。

Dim destination As Range
Set destination = Worksheets("Sheetname").Range("A1")

そして、何かを貼り付ける必要がある場合:

destination.Select
ActiveSheet.Paste
Set destination = destination.Offset(1,0)

このように、destination常に「次に貼り付けられる場所」を指しています。私はそれが役に立ち、よりきれいだと思います。

vba - Excel VBA: コンパイラ エラー

1 に答える 1

Related

Reference

vba - Excel VBA: コンパイラエラー