配列処理をしたいが、値が入らない

Question

Sheet1イメージ↑

Sheet2イメージ↑

Sheet1にある各文字列を基準にしてSheet2にある各文字列と比べます。
そしてどれぐらい違っているか比率をパーセンテージでSheet2のA列のセルにそれぞれ出していきます。
Sheet1の比較対象100個以上に対し、Sheet2には3000個以上文字列データがあり、
セル処理だと時間がかかるので、配列処理にしたいのですが、変数にうまく値が入りません。

例：23行目の「If Table2(k, 2).Value = "" Then」の条件で、文字列が入っているセルでも空欄と認識されてしまい、思い通りの処理になりません。

どなたかお力を貸していただければ幸いです。よろしくお願いします。

1.Sub 比較テスト()

2.Dim i As Long, k As Double, n As Long
3.Dim Table1 As Variant, Table2 As Variant
4.Dim cnt As Integer, str As String
5.Dim Endrow As Integer, Finalrow As Integer
6.Dim S1 As String, S2 As String

7.S1 = "Sheet1"
8.S2 = "Sheet2"

9.Sheets(S1).Activate
10.Endrow = Sheets(S1).Cells(Rows.Count, 1).End(xlUp).Row '翻訳する和文の最終セル

11.S2.Activate
12.Columns(1).Insert Shift:=xlShiftToRight
13.Columns(1).Style = "Percent"
14.Finalrow = Sheets(S2).Cells(Rows.Count, 2).End(xlUp).Row 'Sheet1データ最終セル

15.Sheets(S1).Activate
16.Table1 = Worksheets(S1).Range(Cells(2, 1), Cells(Endrow, 1)) 'Sheet1のデータ範囲を配列化

17.Sheets(S2).Activate
18.Table2 = Worksheets(S2).Range(Cells(3, 2), Cells(Finalrow, 3)) 'Sheet2のデータを配列化

19.For i = 2 To Endrow Step 1 'Sheet1のデータ最終行まで
20.For k = 3 To Finalrow Step 1 'Sheet1とSheet2のデータがまったく同じかを確認
21.Sheets(S2).Activate
22.If Table2(k, 2).Value = "" Then
23.Table2(k, 2).Select
24.ElseIf Len(Table2(k, 2).Value) > Len(Table1(i, 1).Value) Then
25.Sheets(S2).Activate
26.Table2(k, 2).Select
27.ElseIf InStr(Table1(i, 1), Table2(k, 2)) > 0 Then
28.Table2(k, 1) = 1

29.Else 'Sheet1とSheet2のデータデータがまったく同じでなければ、一文字ごとに確認して比率を出す
30.For n = 1 To Len(Table1(i, 1)) Step 1
31.str = Mid(Table1(i, 1), n, 1)
32.If InStr(Table2(k, 2), str) > 0 Then
33.cnt = cnt + 1 '一致した文字をカウントする
34.End If
35.Next n

36.Table2(k, 1) = cnt / Len(Table1(i, 1))
37.cnt = 0
38.End If

39.Sheets(To_Sheet).Range(Table2(3, 1), Table2(Finalrow, 7)).Sort Columns(1), xlDescending
40.If Table2(k, 1).End(xlDown).Row >= 0.7 Then
41.Table1(i, 2).Value = Table2(k, 3).Value

42.Else
43.Sheets(S2).Activate
44.Table2(k, 1).Select
45.End If
46.Next k
47.Next i

48.'配列化したデータをシートに戻す
49.Sheets(S1).Activate
50.Sheets(S1).Range(Cells(2, 1), Cells(Endrow, 2)) = Table1
51.Sheets(S2).Activate
52.Sheets(S2).Range(Cells(3, 1), Cells(Finalrow, 3)) = Table2

53.End Sub

Comments

[y_waiwai]

このままではコードが読みづらいので、質問を編集し、<code>ボタンを押し、出てくる’’’の枠の中にコードを貼り付けてください

[退会済みユーザー]

貼り直しました。よろしくお願いします。

Answer 1

Sub 比較テスト()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim Table1 As Variant, Table2 As Variant
    Dim Endrow As Integer, Finalrow As Integer
    Dim i As Long, k As Double, n As Long
    Dim cnt As Integer, str As String
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
    With ws1
        Endrow = .Cells(.Rows.Count, 1).End(xlUp).Row '翻訳する和文の最終セル
        Set rng1 = .Range(.Cells(2, 1), .Cells(Endrow, 1)) 'Sheet1のデータ範囲を配列化
        Table1 = rng1.Value 'Sheet1のデータ範囲を配列化
    End With
    
    With ws2
        .Columns(1).Insert Shift:=xlShiftToRight
        .Columns(1).Style = "Percent"
        Finalrow = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set rng2 = .Range(.Cells(3, 1), .Cells(Finalrow, 2))
        Table2 = rng2.Value 'Sheet2のデータを配列化
    End With
    
    For i = 1 To UBound(Table1, 1) Step 1 'Sheet1のデータ最終行まで
        For k = 1 to UBound(Table2, 1) Step 1 'Sheet1とSheet2のデータがまったく同じかを確認
            If Table2(k, 2) = "" Then
                'Table2(k, 2)
            ElseIf Len(Table2(k, 2)) > Len(Table1(i, 1)) Then
                'Table2(k, 2).Select
            ElseIf InStr(Table1(i, 1), Table2(k, 2)) > 0 Then
                Table2(k, 1) = 1

            Else 'Sheet1とSheet2のデータがまったく同じでなければ、一文字ごとに確認して比率を出す
                For n = 1 To Len(Table1(i, 1)) Step 1
                    str = Mid(Table1(i, 1), n, 1)
                    If InStr(Table2(k, 2), str) > 0 Then
                        cnt = cnt + 1 '一致した文字をカウントする
                    End If
                Next n

                Table2(k, 1) = cnt / Len(Table1(i, 1))
                cnt = 0
            End If

            'Sheets(To_Sheet).Range(Table2(3, 1), Table2(Finalrow, 7)).Sort Columns(1), xlDescending
            'If Table2(k, 1).End(xlDown).Row >= 0.7 Then
            'Table1(i, 2).Value = Table2(k, 3).Value
            '
            'Else
            'Sheets(S2).Activate
            'Table2(k, 1).Select
            'End If
        Next k
    Next i

    '配列化したデータをシートに戻す
    rng1.Value = Table1
    rng2.Value = Table2

End Sub

Comments

[退会済みユーザー]

jinojiさん
コードの修正、ありがとうございます。
早速動作確認してみたのですが、「If Table2(k, 2) = "" Then」で、「インデックスが有効範囲にありません」とエラーになってしました。「If Table2(k, 2).value = "" Then」にもしてみたのですが、同じでした。もう一度、自分でも確認してみます。

[jinoji]

セル範囲の値を配列に変換した段階で、indexは1からになります。
そのため、For k = 3 To FinalRow とすると計算が合わなくなるということだと思います。
（コードを修正しました。）

[退会済みユーザー]

そうなんですね、知りませんでした...。コードの修正もありがとうございました。動作バッチリです！

Answer 2

###その１

Set Table1 = Worksheets(S1).Range(Cells(2, 1), Cells(Endrow, 1)) 'Sheet1のデータ範囲を配列化 

これでは配列化できていません。Rangeオブジェクトを取得しているだけです。値を配列として取得したいならば以下のようになります。

Table1 = Worksheets(S1).Range(Cells(2, 1), Cells(Endrow, 1)).Value

これで値を配列として取得したならば、Table2(k, 2).Valueのように**.Value**をつけたらエラーになります。

###その２

For k = 3 To Finalrow Step 1
  If Table2(k, 2).Value = "" Then

このループ、範囲がオカシイと思いませんか？
Table2(1, 1) の値はSheet2のB3から拾ってきたものですよ。これだとC5から検査していますけれど、本当に意図したものでしょうか？

###その３
いちいちシートをActivateするのはやめましょう。
シートのオブジェクトに名前をつけて、hogeSheet.Range(ほにゃらら)、hogeSheet.Cells(あれ, これ)のようにした方が良いです。

Comments

[退会済みユーザー]

ishina_yumさん
ご指摘ありがとうございます。勉強になります。
ご指摘のその２ですが、すいません、理解することができませんでした。
配列処理のTable2(k,2)とセル処理だった場合のCells(k,2)とでは指定したセルの場所が変わってきてしまうのでしょうか？（もう一度、配列について勉強してきます...）
またおっしゃる通り、Sheet2のC5は検査対象ではありません。
Sheet2のB3からデータが入っているB列最終行までがチェック対象です。

[退会済みユーザー]

ご指摘のその2ですが、別の方の回答で理解できました。

Answer 3

セル範囲を配列に一括代入する場合、Setは不要です。

Table1 = Worksheets(S1).Range(Cells(2, 1), Cells(Endrow, 1)) 'Sheet1のデータ範囲を配列化
'Set Table1 = Worksheets(S1).Range(Cells(2, 1), Cells(Endrow, 1)) 'Sheet1のデータ範囲を配列化

Comments

[退会済みユーザー]

TanakaHiroakiさん
ご指摘ありがとうございます。
setを抜いてみたのですが、今度は「インデックスが有効範囲にありません」というエラーになってしまいました。