excel - VBAExcel以前の存在に基づいてセルにデータを入力する

Question

これについてはまだ見ていませんが、問題を簡潔に表現する方法がわからないためかもしれません。これが私が試したいことの例です：

状態のイニシャルを保持する列がある場合、その状態が以前に見つかった場合は、出力シートを確認してください。まだ入力されていない場合は、新しいセルにその状態のイニシャルを入力し、カウント（状態が検出された回数）を1に初期化します。状態のイニシャルが出力シート内のセルにある場合は、カウントを1つ増やします。

これにより、ランダムな順序（状態が繰り返される場合と繰り返されない場合があります）の状態を持つ50,000（またはいくつでも）の裏打ちされたExcelシートがある場合、生のデータシートにある状態を出力するクリーンなテーブルを作成できます。そしてそれらが何回現れたか。これについて考える別の方法は、ピボットテーブルをコーディングすることですが、情報は少なくなります。

これを完了する方法について私が考えたいくつかの方法があります。個人的には、これらのどれも非常に良いアイデアではないと思いますが、これから見ていきます。

アルゴリズム1、50のすべての状態：

1. 状態ごとに50個の文字列変数を作成し、カウント用に50個の長い変数を作成します
2. 生のデータシートをループし、特定の状態が見つかった場合は、適切なカウントをインクリメントします（これには、50個のif-elseステートメントが必要です）
3. 結果を出力

全体的に.....ひどい考え

アルゴリズム2、フリップフロップ：

1. 変数を作成しないでください
2. 生のデータシートで状態が見つかった場合は、出力シートを調べて、以前に状態が見つかったかどうかを確認します
3. 以前に状態が見つかった場合は、隣接するセルを1つインクリメントします
4. 以前に状態が見つからなかった場合は、次に使用可能な空白のセルを状態のイニシャルに変更し、隣接するセルを初期化します。
5. 生のデータシートに戻る

全体的に.....これは機能する可能性がありますが、生データシートがそれほど大きくない場合でも、永遠にかかるように感じますが、50ステートアルゴリズムのようにメモリを浪費せず、コード行が少ないという利点があります

ちなみに、ワークブック（またはワークシート）のセルに、そのワークブックをアクティブ化せずにアクセスすることは可能ですか？2番目のアルゴリズムの実行がはるかに速くなるのでお願いします。

ありがとうございました、

ジェシー・スモザーモン

Answer 1

コードを高速化するいくつかのポイント：

1. それらにアクセスするために、アクティブなワークブック、ワークシート、または範囲を作成する必要はありません。

   DIM wb as workbook  
   DIM ws as worksheet  
   DIM rng as range
   
   Set wb = Workbooks.OpenText(Filename:=filePath, Tab:=True) ' or Workbooks("BookName")  
   Set ws = wb.Sheets("SheetName")  
   Set rng = ws.UsedRange ' or ws.[A1:B2], or many other ways of specifying a range  
   

これで、次のようなワークブック/シート/範囲を参照できます。

rng.copy
for each  cl in rng.cells
etc

1. セルのループは非常に遅いです。最初にデータをバリアント配列にコピーしてから、配列をループする方がはるかに高速です。また、シート上に大量のデータを作成する場合は、最初にバリアント配列でデータを作成してから、一度にシートにコピーすることをお勧めします。

   DIM v As Variant
   v = rng
   

たとえば、rngが10行5列の範囲を参照している場合、vは1から10、1から5の薄暗い配列になります。あなたが言及する5分は、おそらく最大で数秒に短縮されます。

Answer 2

   Sub CountStates()
     Dim shtRaw As Excel.Worksheet
     Dim r As Long, nr As Long
     Dim dict As Object
     Dim vals, t, k

    Set dict = CreateObject("scripting.dictionary")
    Set shtRaw = ThisWorkbook.Sheets("Raw")
    vals = Range(shtRaw.Range("C2"), _
                 shtRaw.Cells(shtRaw.Rows.Count, "C").End(xlUp)).Value
    nr = UBound(vals, 1)

    For r = 1 To nr
        t = Trim(vals(r, 1))
        If Len(t) = 0 Then t = "Empty"
        dict(t) = dict(t) + 1
    Next r

    For Each k In dict.keys
        Debug.Print k, dict(k)
    Next k
End Sub

Answer 3

2番目のアルゴリズムを実装して、それがどのように機能するかを確認しました。コードは以下のとおりです。実際の問題の詳細をほとんど省略して、より明確にし、コアの問題に到達しようとしました。申し訳ありません。以下のコードで、他の「パーツ」を追加しました。

コード：

' this number refers to the raw data sheet that has just been activated
totalRow = ActiveSheet.Range("A1").End(xlDown).Row
    For iRow = 2 To totalRow
        ' These are specific to the company needs, refers to addresses
        If (ActiveSheet.Cells(iRow, 2) = "BA") Then
            badAddress = badAddress + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "C") Then
            coverageNoListing = coverageNoListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "L") Then
            activeListing = activeListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "NC") Then
            noCoverageNoListing = noCoverageNoListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "NL") Then
            inactiveListing = inactiveListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "") Then
            noHit = noHit + 1
        End If
        ' Algorithm beginning
        ' If the current cell (in state column) has something in it
        If (ActiveSheet.Cells(iRow, 10) <> "") Then
            ' Save value into a string variable
            tempState = ActiveSheet.Cells(iRow, 10)
            ' If this is also in a billable address make variable true
            If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
                boolStateBillable = True
            End If
            ' Output sheet
            BillableWorkbook.Activate
            For tRow = 2 To endOfState
                ' If the current cell is the state
                If (ActiveSheet.Cells(tRow, 9) = tempState) Then
                    ' Get the current hit count of that state
                    tempStateTotal = ActiveSheet.Cells(tRow, 12)
                    ' Increment the hit count by one
                    ActiveSheet.Cells(tRow, 12) = tempStateTotal + 1
                    ' If the address was billable then increment billable count
                    If (boolStateBillable = True) Then
                        tempStateBillable = ActiveSheet.Cells(tRow, 11)
                        ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1
                    End If
                    Exit For
                ' If the tempState is unique to the column
                ElseIf (tRow = endOfState) Then
                    ' Set state, totalCount
                    ActiveSheet.Cells(tRow - 1, 9) = tempState
                    ActiveSheet.Cells(tRow - 1, 12) = 1
                    ' Increment the ending point of the column
                    endOfState = endOfState + 1
                    ' If it's billable, indicate with number
                    If (boolStateBillable = True) Then
                        tempStateBillable = ActiveSheet.Cells(tRow - 1, 11)
                        ActiveSheet.Cells(tRow - 1, 11) = tempStateBillable + 1
                    End If
                End If
            Next
        ' Activate raw data workbook
        TextFileWorkbook.Activate
        ' reset boolean
        boolStateBillable = False
    Next

一度実行したところ、うまくいったようです。問題は、およそ5分ほどかかったということです。元のコードは、0.2（大まかな推測）を要します。コードの実行を高速化する唯一の方法は、2つのワークブックを何度もアクティブ化しないようにすることだと思います。これは答えが完全ではないことを意味しますが、残りを理解したら編集します。

注：ピボットテーブルに戻って、必要なことをすべて実行できるかどうかを確認します。現時点では、変更できないことがいくつかあるようですが、確認します。

ありがとうございました、

ジェシー・スモザーモン

Answer 4

私は2番目のアルゴリズムを維持しました。私が忘れていた辞書オプションがありますが、それがどのように機能するかについてはまだあまり快適ではなく、一般的にはまだ完全には理解していません。コードを少し試してみて、何かを変更しました。今ではより速く動作します。

コード：

' In output workbook (separate sheet)
Sheets.Add.Name = "Temp_Text_File"

' Opens up raw data workbook (originally text file
Application.DisplayAlerts = False
Workbooks.OpenText Filename:=filePath, Tab:=True
Application.DisplayAlerts = True
Set TextFileWorkbook = ActiveWorkbook
totalRow = ActiveSheet.Range("A1").End(xlDown).Row
' Copy all contents of raw data workbook
Cells.Select
Selection.Copy

BillableWorkbook.Activate

' Paste raw data into "Temp_Text_File" sheet
Range("A1").Select
ActiveSheet.Paste

ActiveWorkbook.Sheets("Billable_PDF").Select

' Populate long variables
For iRow = 2 To totalRow
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "BA") Then
        badAddress = badAddress + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Then
        coverageNoListing = coverageNoListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Then
        activeListing = activeListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NC") Then
        noCoverageNoListing = noCoverageNoListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
        inactiveListing = inactiveListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "") Then
        noHit = noHit + 1
    End If
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10) <> "") Then
        tempState = ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10)
        If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
            boolStateBillable = True
        End If
        'BillableWorkbook.Activate
        For tRow = 2 To endOfState
            If (ActiveSheet.Cells(tRow, 9) = tempState) Then
                tempStateTotal = ActiveSheet.Cells(tRow, 12)
                ActiveSheet.Cells(tRow, 12) = tempStateTotal + 1
                If (boolStateBillable = True) Then
                    tempStateBillable = ActiveSheet.Cells(tRow, 11)
                    ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1
                End If
                Exit For
            ElseIf (tRow = endOfState) Then
                ActiveSheet.Cells(tRow, 9) = tempState
                ActiveSheet.Cells(tRow, 12) = 1
                endOfState = endOfState + 1
                If (boolStateBillable = True) Then
                    tempStateBillable = ActiveSheet.Cells(tRow, 11)
                    ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1
                End If
            End If
        Next
        'stateOneTotal = stateOneTotal + 1
        'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
        '    stateOneBillable = stateOneBillable + 1
        'End If
    'ElseIf (ActiveSheet.Cells(iRow, 10) = "FL") Then
        'stateTwoTotal = stateTwoTotal + 1
        'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
        '    stateTwoBillable = stateTwoBillable + 1
        'End If
    End If
    'TextFileWorkbook.Activate
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
        billableCount = billableCount + 1
    End If
    boolStateBillable = False
Next

' Close raw data workbook and raw data worksheet
Application.DisplayAlerts = False
TextFileWorkbook.Close
ActiveWorkbook.Sheets("Temp_Text_File").Delete
Application.DisplayAlerts = True

コメントや提案をありがとうございます。いつものように大変感謝しています。

ジェシー・スモザーモン