2

毎月 Excel ファイルを受け取り、その一部を新しいファイルにエクスポートする必要があります。識別番号のリストがあり、選択したリスト内の番号のリストを完全なファイルに一致させ、関連データの行を新しいシートにエクスポートしようとしています。

Sub Run_All_Macros()
Application.ScreenUpdating = False
Sheets.Add.Name = "Output"
Call Convert_to_Numbers
Call Highlight_Selected_Contractors
End Sub

'Original Spreadsheet is formatted incorrectly
'Convert PSD Codes to Numbers
Sub Convert_to_Numbers()
Dim xCell As Range
Range("A2:A2500").Select
    For Each xCell In Selection
    xCell.Value = CDec(xCell.Value)
    Next xCell
End Sub


'Highlight Selected Contractors
Sub Highlight_Selected_Contractors()
Dim Full, Selection, Code, SelectedCode As Range
Worksheets("Sheet1").Select
'Set all cells in Column A Sheet 1 to Full
Set Full = Worksheets("Sheet1").Range("A1", Range("A1").End(xlDown))
'Set all cells in Column A Sheet 2 to Selection
Worksheets("Sheet2").Select
Set Selection = Worksheets("Sheet2").Range("A1", Range("A1").End(xlDown))
'If the numbers match highlight the cell
For Each Code In Full
    For Each SelectedCode In Selection
        If Code.Value = SelectedCode.Value Then
       *** Code.Select
        Selection.Copy
        Sheets.Select ("Output")
        ActiveSheet.Paste
    End If
Next SelectedCode
Next Code
End Sub

このコードを実行すると、「出力」の列 A が A2:A2500 からゼロで埋められます。ブレークポイントをいじってみると、 *を配置した場所に問題があることがわかりましたが、そこに書かれている内容の何が問題なのかわかりません。

ありがとう

4

1 に答える 1

3

上記のコードにはいくつかのエラーがあり、いくつかの提案と最終的なコードもあります。

エラー

1) Sheets.Add.Name = "Output"「出力」というシートが既に存在する場合、この行はエラーになります。シートを削除してから作成してください。シートが存在しない場合、どうすれば削除できるのでしょうか? このようなシナリオOn Error Resume Nextでは、ほとんどの場合避けるべきものを使用できます。

2)範囲を操作するときは、参照しているシートを常に指定してください。そうしないと、Excel は常に「ActiveSheet」を参照していると見なします。「出力」シートで操作を実行したいのに、シートを考慮Sub Convert_to_Numbers()していることに気付いたようです。Output

3) Dim Full, Selection, Code, SelectedCode As Range前のコメントで述べたように、Excel の予約語を変数として使用することは避けてください。また、VB.Net とは異なり、VBA で行ったように変数を宣言すると、最後の変数のみが として宣言されRangeます。他の 3 つはバリアントとして宣言されます。VB は、変数を Variant 型にデフォルト設定します。Variant 型の変数は、文字列から整数、長整数、日付、通貨など、あらゆる種類のデータを保持できます。デフォルトでは、「Variant」は「最も遅い」タイプの変数です。バリアントは、「型の不一致エラー」を引き起こす可能性があるため、避ける必要があります。バリアントを使用してはいけないというわけではありません。コード実行時に保持される可能性があるものが不明な場合にのみ使用してください。

4).ActiveCell、Selection、Selectなどの単語の使用は避けてくださいActivate。これらはエラーの主な原因です。また、コードが遅くなります。

提案

1)毎回 Sheets("WhatEver") を使用する代わりに、変数に格納してからその変数を使用します。コードを削減します。

2)コードをインデントします :) 読みやすくなります

3)タスクをグループ化します。たとえば、特定のシートで何かを行う必要がある場合は、一緒に保管してください。読みやすく、必要に応じて修正できます。

4)値をハードコーディングする代わりに、実際の範囲を取得します。Range("A2:A2500")は典型的な例です。2500年までデータは常にありますか？それが少ないか多い場合はどうなりますか？

5） End(xlDown)間に空白のセルがある場合、最後の行は表示されません。列の最後の行を取得するには、「Sheet1」の A と言って、これを使用します

Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row`

6)ループする代わりに、WorksheetFunction CountIf(). ループはコードの速度を低下させるため、できる限り避ける必要があります。

7)適切なエラー処理を使用します。

8)コードにコメントを付けます。特定のコードまたはセクションが何をしているかを知ることは、はるかに簡単です。

コード

Option Explicit

Sub Run_All_Macros()
    Dim ws1I As Worksheet, ws2I As Worksheet, wsO As Worksheet
    Dim ws1LRow As Long, ws2LRow As Long, wsOLr As Long
    Dim xCell As Range, rFull As Range, rSelection As Range
    Dim rCode As Range, rSelectedCode As Range

    On Error GoTo Whoa '<~~ Error Handling

    Application.ScreenUpdating = False

    '~~> Creating the Output Sheet
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Output").Delete
    On Error GoTo 0
    Sheets.Add.Name = "Output"
    Application.DisplayAlerts = True

    '~~> Working with 1st Input Sheet
    Set ws1I = Sheets("Sheet1")
    With ws1I
        '~~> Get Last Row of Col A
        ws1LRow = .Range("A" & Rows.Count).End(xlUp).Row
        '~~> Set the range we want to work with
        Set rFull = .Range("A1:A" & ws1LRow)
        '~~> The following is not required unless you want to just format the sheet
        '~~> This will have no impact on the comparision. If you want you can
        '~~> uncomment it
        'For Each xCell In .Range("A2:A" & ws1LRow)
            'xCell.Value = CDec(xCell.Value)
        'Next xCell
    End With

    '~~> Working with 2nd Input Sheet
    Set ws2I = Sheets("Sheet2") '<~~ Input Sheet 2
    ws2LRow = ws2I.Range("A" & Rows.Count).End(xlUp).Row
    Set rSelection = ws2I.Range("A1:A" & ws2LRow)

    '~~> Working with Output Sheet
    Set wsO = Sheets("Output")
    wsO.Range("A1") = "Common values"
    wsOLr = wsO.Range("A" & Rows.Count).End(xlUp).Row + 1

    '~~> Comparison : If the numbers match copy them to Output Sheet
    For Each rCode In rFull
        If Application.WorksheetFunction.CountIf(rSelection, rCode.Value) > 0 Then
            rCode.Copy wsO.Range("A" & wsOLr)
            wsOLr = wsOLr + 1
        End If
    Next rCode

    MsgBox "Done"

LetsContinue:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

それでもエラーが発生する場合はお知らせください:)

HTH

于 2012-04-24T13:40:19.690 に答える