Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3863 / 13645 ツリー ←次へ | 前へ→

【59795】2bookの文字列を比較する みみん 09/1/8(木) 21:02 質問[未読]
【59797】Re:2bookの文字列を比較する かみちゃん 09/1/8(木) 21:13 発言[未読]
【59798】Re:2bookの文字列を比較する みみん 09/1/8(木) 21:29 発言[未読]
【59799】Re:2bookの文字列を比較する n 09/1/8(木) 21:29 発言[未読]
【59801】Re:2bookの文字列を比較する みみん 09/1/8(木) 21:50 発言[未読]
【59802】Re:2bookの文字列を比較する Hirofumi 09/1/8(木) 22:47 発言[未読]
【59804】Re:2bookの文字列を比較する みみん 09/1/9(金) 3:50 お礼[未読]

【59795】2bookの文字列を比較する
質問  みみん  - 09/1/8(木) 21:02 -

引用なし
パスワード
   こんばんは。

下記のようなbookが二つあります。
旧.xlsx
C列 D列
123 田中
456 山本
789 下田

新.xlsx
C列 D列
123 田中
111 神田
456 山本
555 佐藤
789 下田

まとめ.xlsx
A列 B列 C列
123 田中 変更なし
456 山本 変更なし
789 下田 変更なし
111 神田 追加
555 佐藤 追加

2つのbookのC列から一致するデータをまとめ.xlsxに書き出すのは
下記のように書きましたが
Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Valueで、
インデックスが有効範囲ではありませんというエラーがでます。

また追加されているデータを書く方法もわからずにいます。
教えていただきたく、投稿させて頂きました。
よろしくお願いいたします。

Sub test()

Dim FL1 As Variant
Dim FL2 As Variant
Dim CROW1 As Long
Dim CROW2 As Long
Dim Range1, Range2 As Range
Dim CL1, CL2 As Range
Dim FR As Range
Dim Lastrow As Long
Dim i As Long

FL1 = "C:・・・\Desktop\旧.xlsx"
FL2 = "C:・・・\Desktop\新.xlsx"

Workbooks.Open FL1
CROW1 = Worksheets("旧").Cells(65536, 3).End(xlUp).Row
Set Range1 = Worksheets("旧").Range(Cells(2, 3), Cells(CROW1, 3))

Workbooks.Open FL2
CROW2 = Worksheets("新").Cells(65536, 3).End(xlUp).Row
Set Range2 = Worksheets("新").Range(Cells(2, 3), Cells(CROW2, 3))


For Each CL1 In Range1
  Set FR = Range2.Find(what:=CL1.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not FR Is Nothing Then
      Lastrow = ThisWorkbook.Worksheets("Sheet1").Cells(65536, 1).End(xlUp).Row + 1
      For i = 1 To Lastrow
        Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Value
        Worksheets("Sheet1").Cells(Lastrow, 2) = FR.Offset(, 1).Value
        Worksheets("Sheet1").Cells(Lastrow, 3) = "変更なし"
      Next
     
    End If
Next

End Sub

【59797】Re:2bookの文字列を比較する
発言  かみちゃん E-MAIL  - 09/1/8(木) 21:13 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Valueで、
>インデックスが有効範囲ではありませんというエラーがでます。

アクティブブックは、何かわかっていますか?
そのブックにSheet1という名前のシートはありますか?

【59798】Re:2bookの文字列を比較する
発言  みみん  - 09/1/8(木) 21:29 -

引用なし
パスワード
   ▼かみちゃん さん:
ご返信ありがとうございます。

>>Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Valueで、
>>インデックスが有効範囲ではありませんというエラーがでます。
>
>アクティブブックは、何かわかっていますか?
>そのブックにSheet1という名前のシートはありますか?

Thisworkbook.Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Value
にするとできました。
アクティブブックが違っていました。
ありがとうございます。

【59799】Re:2bookの文字列を比較する
発言  n  - 09/1/8(木) 21:29 -

引用なし
パスワード
   >Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Valueで、
>インデックスが有効範囲ではありませんというエラーがでます。
Worksheets("Sheet1")の親Bookを明示していないからでしょう。
そのままだとActiveWorkbookのWorksheets("Sheet1")を指定しています。
つまり
>FL2 = "C:・・・\Desktop\新.xlsx"
これがActiveWorkbookになっています。
>Lastrow = ThisWorkbook.Worksheets("Sheet1").Cells(65536, 1).End(xlUp).Row + 1
ここで明示しているのと同じようにしてみてください。

ただ、
>For i = 1 To Lastrow
>  Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Value
>  Worksheets("Sheet1").Cells(Lastrow, 2) = FR.Offset(, 1).Value
>  Worksheets("Sheet1").Cells(Lastrow, 3) = "変更なし"
>Next
ここでどういう動作をしているか理解されてますか?
>For i = 1 To Lastrow
>Next
これは不要ですよね?


そもそも、Findメソッドを使ってLoopしなくても良いと思います。
新.xlsx から まとめ.xlsx へ全データをコピーして、
作業列にMatch関数を使って 旧.xlsx を参照して、
あれば"変更なし"、無ければ"追加"で良くないですか?

【59801】Re:2bookの文字列を比較する
発言  みみん  - 09/1/8(木) 21:50 -

引用なし
パスワード
   ▼n さん:
ご返信ありがとうございます。

>>Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Valueで、
>>インデックスが有効範囲ではありませんというエラーがでます。
>Worksheets("Sheet1")の親Bookを明示していないからでしょう。
>そのままだとActiveWorkbookのWorksheets("Sheet1")を指定しています。
>つまり
>>FL2 = "C:・・・\Desktop\新.xlsx"
>これがActiveWorkbookになっています。
>>Lastrow = ThisWorkbook.Worksheets("Sheet1").Cells(65536, 1).End(xlUp).Row + 1
>ここで明示しているのと同じようにしてみてください。
その通りでした。
thisworkbook.Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Value
に書き換えるとできました。

>
>ただ、
>>For i = 1 To Lastrow
>>  Worksheets("Sheet1").Cells(Lastrow, 1) = FR.Value
>>  Worksheets("Sheet1").Cells(Lastrow, 2) = FR.Offset(, 1).Value
>>  Worksheets("Sheet1").Cells(Lastrow, 3) = "変更なし"
>>Next
>ここでどういう動作をしているか理解されてますか?
>>For i = 1 To Lastrow
>>Next
>これは不要ですよね?
確かに不要です・・・

>
>
>そもそも、Findメソッドを使ってLoopしなくても良いと思います。
>新.xlsx から まとめ.xlsx へ全データをコピーして、
>作業列にMatch関数を使って 旧.xlsx を参照して、
>あれば"変更なし"、無ければ"追加"で良くないですか?

ここではC列だけで書かせて頂きましたが、
実際はあと3列の文字列が同じかを条件にしています。

If Not FR Is Nothing Thenのあとに
If FR.Offset(, 1).Value = CL1.Offset(, 1).Value Then
のような条件が3つ続いています。
(旧fileから新fileに変更され、担当者が同じかどうかの確認のためなど)
なのでFindを使って書いていました。

説明不足で申し訳ありませんでした。


       

【59802】Re:2bookの文字列を比較する
発言  Hirofumi  - 09/1/8(木) 22:47 -

引用なし
パスワード
   こんな事すると出来るかも?
"旧.xlsx"、"新.xlsx"は開いてている物とします
出力はマクロの或るBookのSheet3とします

Option Explicit
Option Compare Text

Public Sub DataMatch2()

'  固有データのチェック

  '"旧"のデータ列数(C列〜D列)
  Const clngColumns1 As Long = 2
  '"新"のデータ列数(C列〜D列)
  Const clngColumns2 As Long = 2
  
  Dim rngList1 As Range
  Dim vntList1 As Variant
  Dim lngRows1 As Long
  Dim lngComp1 As Long
  Dim vntKeys1 As Variant
  Dim rngList2 As Range
  Dim vntList2 As Variant
  Dim lngRows2 As Long
  Dim lngComp2 As Long
  Dim vntKeys2 As Variant
  Dim lngMatch As Long
  Dim rngResult As Range
  Dim lngWrite As Long
  Dim strProm As String

  '"旧"データシートのA1を基準とします
  Set rngList1 = Workbooks("旧.xlsx").Worksheets("旧").Cells(1, "C")
  
  '"新"データシートのA1を基準とする
  Set rngList2 = Workbooks("新.xlsx").Worksheets("新").Cells(1, "C")
  
  '出力シートの基準位置を設定
  Set rngResult = ThisWorkbook.Worksheets("Sheet1").Cells(1, "A")
  
  '"旧"の比較列の列挙(基準セル位置からの列Offsetを列挙)
  'C列=0、D列=1
  vntKeys1 = Array(0, 1)
  '"新"の比較列の列挙(基準セル位置からの列Offsetを列挙)
  'C列=0、D列=1
  vntKeys2 = Array(0, 1)
  
  '"旧"の比較データを保持する配列を確保
  ReDim vntList1(0 To UBound(vntKeys1))
  '"新"の比較データを保持する配列を確保
  ReDim vntList2(0 To UBound(vntKeys1))
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '"旧"の基準に就いて
  If Not GetBasicData(rngList1, lngRows1, clngColumns1, vntKeys1, vntList1) Then
    strProm = rngList1.Parent.Name & "にデータが有りません"
    GoTo Wayout
  End If
  
  '"新"基準に就いて
  If Not GetBasicData(rngList2, lngRows2, clngColumns2, vntKeys2, vntList2) Then
    strProm = rngList2.Parent.Name & "にデータが有りません"
    GoTo Wayout
  End If
  
  '"旧"のシートの比較位置
  lngComp1 = 1
  '"新"のシートの比較位置
  lngComp2 = 1
  '"旧"のシート若しくは、"新"のシートが最終行に達するまで繰り返し
  Do Until lngComp1 > lngRows1 And lngComp2 > lngRows2
    '各列のデータを比較
    lngMatch = DataCompare(vntList1, lngComp1, vntList2, lngComp2)
    '比較結果に就いて
    Select Case lngMatch
      Case Is = 0 'Matchiした場合
        '出力行位置を更新
        lngWrite = lngWrite + 1
        '行を出力
        With rngResult
          rngList1.Offset(lngComp1).Resize(, clngColumns1).Copy _
              Destination:=.Offset(lngWrite)
          .Offset(lngWrite, clngColumns1).Value = "変更なし"
        End With
        '"新"のシートの比較位置を更新
        lngComp2 = lngComp2 + 1
        '"旧"のシートの比較位置を更新
        lngComp1 = lngComp1 + 1
      Case Is = -1 '"旧"の固有値の場合
        '出力行位置を更新
        lngWrite = lngWrite + 1
        '行を出力
        With rngResult
          rngList1.Offset(lngComp1).Resize(, clngColumns1).Copy _
              Destination:=.Offset(lngWrite)
          .Offset(lngWrite, clngColumns1).Value = "削除"
        End With
        '"旧"のシートの比較位置を更新
        lngComp1 = lngComp1 + 1
      Case Is = 1 '"新"の固有値の場合
        '出力行位置を更新
        lngWrite = lngWrite + 1
        '行を出力
        With rngResult
          rngList2.Offset(lngComp2).Resize(, clngColumns2).Copy _
              Destination:=.Offset(lngWrite)
          .Offset(lngWrite, clngColumns1).Value = "追加"
        End With
        '"新"のシートの比較位置を更新
        lngComp2 = lngComp2 + 1
    End Select
  Loop
  
  '"旧"のシートの順位を復帰
  DataRestore rngList1, lngRows1, clngColumns1
  
  '"新"のシートの順位を復帰
  DataRestore rngList2, lngRows2, clngColumns2

  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList1 = Nothing
  Set rngList2 = Nothing
  Set rngResult = Nothing
  
  MsgBox strProm, vbInformation
  
End Sub

Private Function GetBasicData(rngList As Range, _
                lngRows As Long, _
                lngColumns As Long, _
                vntKeys As Variant, _
                vntData As Variant) As Boolean

  Dim i As Long
  Dim lngNumb() As Long
  
  '基準に就いて
  With rngList
    '行数を取得
    lngRows = .Offset(Rows.Count - .Row, vntKeys(0)).End(xlUp).Row - .Row
    'データが無ければFunctionを抜ける(戻り値=False)
    If lngRows <= 0 Then
      Exit Function
    End If
    '復帰用整列Keyを作成
    ReDim lngNumb(1 To lngRows, 1 To 1)
    For i = 1 To lngRows
      lngNumb(i, 1) = i
    Next i
    '復帰用Keyの出力列を挿入
    .Offset(1, lngColumns).EntireColumn.Insert
    '復帰用Keyの出力
    .Offset(1, lngColumns).Resize(lngRows).Value = lngNumb
    'データをvntKeys1列で整列
    For i = UBound(vntKeys) To 0 Step -1
      DataSort .Offset(1).Resize(lngRows, lngColumns + 1), .Offset(1, vntKeys(i))
    Next i
    '比較用配列にデータを取得
    For i = 0 To UBound(vntKeys)
      vntData(i) = .Offset(1, vntKeys(i)).Resize(lngRows + 1).Value
    Next i
  End With
  
  GetBasicData = True

End Function

Private Sub DataRestore(rngList As Range, lngRows As Long, lngColumns As Long)

  With rngList
    '元データ順位を復帰
    DataSort .Offset(1).Resize(lngRows, lngColumns + 1), .Offset(1, lngColumns)
    '復帰用Key列を削除
    .Offset(1, lngColumns).EntireColumn.Delete
  End With

End Sub

Private Sub DataSort(rngScope As Range, _
          rngKey As Range, _
          Optional lngOrientation As Long = xlTopToBottom)

  rngScope.Sort _
      Key1:=rngKey, Order1:=xlAscending, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=lngOrientation, SortMethod:=xlStroke

End Sub

Private Function DataCompare(vntKeys1 As Variant, lngPos1 As Long, _
            vntKeys2 As Variant, lngPos2 As Long) As Long

'  データの大小比較

  Dim i As Long
  Dim lngMax As Long
  
  '比較位置がDataEndを超えた場合
  If lngPos1 > UBound(vntKeys1(0), 1) - 1 Then
    DataCompare = 1
    Exit Function
  End If
  If lngPos2 > UBound(vntKeys2(0), 1) - 1 Then
    DataCompare = -1
    Exit Function
  End If
    
  '1行の最大比較回数を取得(実際は0から始まる為、回数としては+1と成る)
  lngMax = UBound(vntKeys1, 1)
  
  '1行のKeyを先頭から比較
  For i = 0 To lngMax
    'もし、Keyが不一致なら
    If vntKeys1(i)(lngPos1, 1) <> vntKeys2(i)(lngPos2, 1) Then
      'Forを抜ける
      Exit For
    End If
  Next i
  
  'Keyが全て一致した場合(Forが全て回り終った場合、iはlngMax+1と成る)
  If i > lngMax Then
    '戻り値の値として、「等しい」を返す
    DataCompare = 0
  Else
    'vntKeys1の値が、vntKeys2の値因り小さい場合
    If vntKeys1(i)(lngPos1, 1) < vntKeys2(i)(lngPos2, 1) Then
      '戻り値の値として、「小さい」を返す
      DataCompare = -1
    Else
      '戻り値の値として、「大きい」を返す
      DataCompare = 1
    End If
  End If
  
End Function

【59804】Re:2bookの文字列を比較する
お礼  みみん  - 09/1/9(金) 3:50 -

引用なし
パスワード
   ▼Hirofumi さん:
ありがとうございます。
私にはかなり難しすぎました。
解説も丁寧に書いてくださっているので
調べて理解していきます。

>こんな事すると出来るかも?
>"旧.xlsx"、"新.xlsx"は開いてている物とします
>出力はマクロの或るBookのSheet3とします
>
>Option Explicit
>Option Compare Text
>
>Public Sub DataMatch2()
>
>'  固有データのチェック
>
>  '"旧"のデータ列数(C列〜D列)
>  Const clngColumns1 As Long = 2
>  '"新"のデータ列数(C列〜D列)
>  Const clngColumns2 As Long = 2
>  
>  Dim rngList1 As Range
>  Dim vntList1 As Variant
>  Dim lngRows1 As Long
>  Dim lngComp1 As Long
>  Dim vntKeys1 As Variant
>  Dim rngList2 As Range
>  Dim vntList2 As Variant
>  Dim lngRows2 As Long
>  Dim lngComp2 As Long
>  Dim vntKeys2 As Variant
>  Dim lngMatch As Long
>  Dim rngResult As Range
>  Dim lngWrite As Long
>  Dim strProm As String
>
>  '"旧"データシートのA1を基準とします
>  Set rngList1 = Workbooks("旧.xlsx").Worksheets("旧").Cells(1, "C")
>  
>  '"新"データシートのA1を基準とする
>  Set rngList2 = Workbooks("新.xlsx").Worksheets("新").Cells(1, "C")
>  
>  '出力シートの基準位置を設定
>  Set rngResult = ThisWorkbook.Worksheets("Sheet1").Cells(1, "A")
>  
>  '"旧"の比較列の列挙(基準セル位置からの列Offsetを列挙)
>  'C列=0、D列=1
>  vntKeys1 = Array(0, 1)
>  '"新"の比較列の列挙(基準セル位置からの列Offsetを列挙)
>  'C列=0、D列=1
>  vntKeys2 = Array(0, 1)
>  
>  '"旧"の比較データを保持する配列を確保
>  ReDim vntList1(0 To UBound(vntKeys1))
>  '"新"の比較データを保持する配列を確保
>  ReDim vntList2(0 To UBound(vntKeys1))
>  
>  '画面更新を停止
>  Application.ScreenUpdating = False
>  
>  '"旧"の基準に就いて
>  If Not GetBasicData(rngList1, lngRows1, clngColumns1, vntKeys1, vntList1) Then
>    strProm = rngList1.Parent.Name & "にデータが有りません"
>    GoTo Wayout
>  End If
>  
>  '"新"基準に就いて
>  If Not GetBasicData(rngList2, lngRows2, clngColumns2, vntKeys2, vntList2) Then
>    strProm = rngList2.Parent.Name & "にデータが有りません"
>    GoTo Wayout
>  End If
>  
>  '"旧"のシートの比較位置
>  lngComp1 = 1
>  '"新"のシートの比較位置
>  lngComp2 = 1
>  '"旧"のシート若しくは、"新"のシートが最終行に達するまで繰り返し
>  Do Until lngComp1 > lngRows1 And lngComp2 > lngRows2
>    '各列のデータを比較
>    lngMatch = DataCompare(vntList1, lngComp1, vntList2, lngComp2)
>    '比較結果に就いて
>    Select Case lngMatch
>      Case Is = 0 'Matchiした場合
>        '出力行位置を更新
>        lngWrite = lngWrite + 1
>        '行を出力
>        With rngResult
>          rngList1.Offset(lngComp1).Resize(, clngColumns1).Copy _
>              Destination:=.Offset(lngWrite)
>          .Offset(lngWrite, clngColumns1).Value = "変更なし"
>        End With
>        '"新"のシートの比較位置を更新
>        lngComp2 = lngComp2 + 1
>        '"旧"のシートの比較位置を更新
>        lngComp1 = lngComp1 + 1
>      Case Is = -1 '"旧"の固有値の場合
>        '出力行位置を更新
>        lngWrite = lngWrite + 1
>        '行を出力
>        With rngResult
>          rngList1.Offset(lngComp1).Resize(, clngColumns1).Copy _
>              Destination:=.Offset(lngWrite)
>          .Offset(lngWrite, clngColumns1).Value = "削除"
>        End With
>        '"旧"のシートの比較位置を更新
>        lngComp1 = lngComp1 + 1
>      Case Is = 1 '"新"の固有値の場合
>        '出力行位置を更新
>        lngWrite = lngWrite + 1
>        '行を出力
>        With rngResult
>          rngList2.Offset(lngComp2).Resize(, clngColumns2).Copy _
>              Destination:=.Offset(lngWrite)
>          .Offset(lngWrite, clngColumns1).Value = "追加"
>        End With
>        '"新"のシートの比較位置を更新
>        lngComp2 = lngComp2 + 1
>    End Select
>  Loop
>  
>  '"旧"のシートの順位を復帰
>  DataRestore rngList1, lngRows1, clngColumns1
>  
>  '"新"のシートの順位を復帰
>  DataRestore rngList2, lngRows2, clngColumns2
>
>  strProm = "処理が完了しました"
>  
>Wayout:
>  
>  '画面更新を再開
>  Application.ScreenUpdating = True
>  
>  Set rngList1 = Nothing
>  Set rngList2 = Nothing
>  Set rngResult = Nothing
>  
>  MsgBox strProm, vbInformation
>  
>End Sub
>
>Private Function GetBasicData(rngList As Range, _
>                lngRows As Long, _
>                lngColumns As Long, _
>                vntKeys As Variant, _
>                vntData As Variant) As Boolean
>
>  Dim i As Long
>  Dim lngNumb() As Long
>  
>  '基準に就いて
>  With rngList
>    '行数を取得
>    lngRows = .Offset(Rows.Count - .Row, vntKeys(0)).End(xlUp).Row - .Row
>    'データが無ければFunctionを抜ける(戻り値=False)
>    If lngRows <= 0 Then
>      Exit Function
>    End If
>    '復帰用整列Keyを作成
>    ReDim lngNumb(1 To lngRows, 1 To 1)
>    For i = 1 To lngRows
>      lngNumb(i, 1) = i
>    Next i
>    '復帰用Keyの出力列を挿入
>    .Offset(1, lngColumns).EntireColumn.Insert
>    '復帰用Keyの出力
>    .Offset(1, lngColumns).Resize(lngRows).Value = lngNumb
>    'データをvntKeys1列で整列
>    For i = UBound(vntKeys) To 0 Step -1
>      DataSort .Offset(1).Resize(lngRows, lngColumns + 1), .Offset(1, vntKeys(i))
>    Next i
>    '比較用配列にデータを取得
>    For i = 0 To UBound(vntKeys)
>      vntData(i) = .Offset(1, vntKeys(i)).Resize(lngRows + 1).Value
>    Next i
>  End With
>  
>  GetBasicData = True
>
>End Function
>
>Private Sub DataRestore(rngList As Range, lngRows As Long, lngColumns As Long)
>
>  With rngList
>    '元データ順位を復帰
>    DataSort .Offset(1).Resize(lngRows, lngColumns + 1), .Offset(1, lngColumns)
>    '復帰用Key列を削除
>    .Offset(1, lngColumns).EntireColumn.Delete
>  End With
>
>End Sub
>
>Private Sub DataSort(rngScope As Range, _
>          rngKey As Range, _
>          Optional lngOrientation As Long = xlTopToBottom)
>
>  rngScope.Sort _
>      Key1:=rngKey, Order1:=xlAscending, _
>      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
>      Orientation:=lngOrientation, SortMethod:=xlStroke
>
>End Sub
>
>Private Function DataCompare(vntKeys1 As Variant, lngPos1 As Long, _
>            vntKeys2 As Variant, lngPos2 As Long) As Long
>
>'  データの大小比較
>
>  Dim i As Long
>  Dim lngMax As Long
>  
>  '比較位置がDataEndを超えた場合
>  If lngPos1 > UBound(vntKeys1(0), 1) - 1 Then
>    DataCompare = 1
>    Exit Function
>  End If
>  If lngPos2 > UBound(vntKeys2(0), 1) - 1 Then
>    DataCompare = -1
>    Exit Function
>  End If
>    
>  '1行の最大比較回数を取得(実際は0から始まる為、回数としては+1と成る)
>  lngMax = UBound(vntKeys1, 1)
>  
>  '1行のKeyを先頭から比較
>  For i = 0 To lngMax
>    'もし、Keyが不一致なら
>    If vntKeys1(i)(lngPos1, 1) <> vntKeys2(i)(lngPos2, 1) Then
>      'Forを抜ける
>      Exit For
>    End If
>  Next i
>  
>  'Keyが全て一致した場合(Forが全て回り終った場合、iはlngMax+1と成る)
>  If i > lngMax Then
>    '戻り値の値として、「等しい」を返す
>    DataCompare = 0
>  Else
>    'vntKeys1の値が、vntKeys2の値因り小さい場合
>    If vntKeys1(i)(lngPos1, 1) < vntKeys2(i)(lngPos2, 1) Then
>      '戻り値の値として、「小さい」を返す
>      DataCompare = -1
>    Else
>      '戻り値の値として、「大きい」を返す
>      DataCompare = 1
>    End If
>  End If
>  
>End Function

3863 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free