Excel VBA質問箱 IV

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

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


11245 / 13646 ツリー ←次へ | 前へ→

【17029】VBAでセルとセルの比較 弘美 04/8/19(木) 20:27 質問[未読]
【17031】Re:VBAでセルとセルの比較 Asaki 04/8/19(木) 23:05 発言[未読]
【17036】Re:VBAでセルとセルの比較 ichinose 04/8/20(金) 8:55 発言[未読]
【17037】Re:VBAでセルとセルの比較 IROC 04/8/20(金) 8:59 回答[未読]
【17046】Re:VBAでセルとセルの比較 弘美 04/8/20(金) 13:12 回答[未読]
【17047】Re:VBAでセルとセルの比較 IROC 04/8/20(金) 13:28 回答[未読]
【17082】Re:VBAでセルとセルの比較 ichinose 04/8/21(土) 10:30 発言[未読]
【17083】Re:VBAでセルとセルの比較 訂正 ichinose 04/8/21(土) 12:16 発言[未読]
【17166】Re:VBAでセルとセルの比較 弘美 04/8/24(火) 14:27 発言[未読]
【17167】Re:VBAでセルとセルの比較 IROC 04/8/24(火) 14:47 回答[未読]
【17245】Re:VBAでセルとセルの比較 弘美 04/8/25(水) 13:57 お礼[未読]

【17029】VBAでセルとセルの比較
質問  弘美  - 04/8/19(木) 20:27 -

引用なし
パスワード
   弘美と申します。 こんにちわ(^^;
早速ですがVBAでセルとセルの内容を比較する方法を調べています。
内容だけならわかるのですがセルの内容全て(書式(網掛けの色とか文字色など)、コメントの有無、内容、)比較したいのです。
どなたか教えてくださいませんか。 よろしくお願い致します。

【17031】Re:VBAでセルとセルの比較
発言  Asaki  - 04/8/19(木) 23:05 -

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

たぶん、調べたい全てのプロパティについて、地道に比較しないとダメだと思います。

処理そのものも結構大変だと思いますが、因みに、どのような目的でこのようなことをしたいのでしょうか?

【17036】Re:VBAでセルとセルの比較
発言  ichinose  - 04/8/20(金) 8:55 -

引用なし
パスワード
   弘美 さん、Asakiさん、おはようございます。

>早速ですがVBAでセルとセルの内容を比較する方法を調べています。
>内容だけならわかるのですがセルの内容全て(書式(網掛けの色とか文字色など)、コメントの有無、内容、)比較したいのです。
>どなたか教えてくださいませんか。 よろしくお願い致します。

Asakiさんがおっしゃっているように地道に比較をするということは
同感なんですが・・。

CallByNameという関数を使用してみると少しだけコードが簡単になるかもしれませんよ。

一例ですが、
'====================================================
Type att
  p_type As Long 'p_nameが  0:プロパティ 1:オブジェクト
  p_name As String 'プロパティ名
  sp_name As String 'p_nameがオブジェクトの場合のプロパティ名
  End Type


'====================================================
Sub Samp1()
  Dim myRange As Range
  Dim myPrName(1 To 6) As att
  Dim i As Integer
  Dim mes As String
  myPrName(1).p_name = "NumberFormatLocal"
  myPrName(1).p_type = 0
  myPrName(2).p_name = "value"
  myPrName(2).p_type = 0
  myPrName(3).p_name = "Interior"
  myPrName(3).p_type = 1
  myPrName(3).sp_name = "colorindex"
  myPrName(4).p_name = "Interior"
  myPrName(4).p_type = 1
  myPrName(4).sp_name = "PatternColorIndex"
  myPrName(5).p_name = "Font"
  myPrName(5).p_type = 1
  myPrName(5).sp_name = "ColorIndex"
  myPrName(6).p_name = "Style"
  myPrName(6).p_type = 0
  Set myRange = Selection

  For i = 1 To 6
    With myPrName(i)
      If .p_type = 0 Then
       mes = mes & .p_name & vbTab & _
         CallByName(myRange, .p_name, VbGet) & vbCr
      Else
       Set obj = CallByName(myRange, .p_name, VbGet)
       mes = mes & .p_name & "." & .sp_name & vbTab & _
         CallByName(obj, .sp_name, VbGet) & vbCr
       End If
      End With
  Next i

  MsgBox mes

End Sub

確認して下さい

【17037】Re:VBAでセルとセルの比較
回答  IROC  - 04/8/20(金) 8:59 -

引用なし
パスワード
   比較して、その後どのようにしたいのでしょうか?

【17046】Re:VBAでセルとセルの比較
回答  弘美  - 04/8/20(金) 13:12 -

引用なし
パスワード
   Asaki ichinose IROCさん こんにちは(^^;
早速投稿してくれてありがとうございます。
なぜセルとセルの比較をしたいのかと言うとお仕事で頻繁に皆が共有しているEXCELファイルがあるのですが修正していると他の人が使えなくなるので、そのEXCELファイルを自分のパソコンで修正して共有しているEXCELファイルに上書き保存をしたいのです。
そうした時単純に上書き保存ができないのです。皆が使っているファイルの内容をその
共有しているEXCELファイルに反映させなくてはいけないんです。そうした時プログラムを動かして皆が修正したファイルを集めてその内容を共有しているEXCELファイルに反映させそのデータを皆のEXCELファイルに戻す作業をしたいのです。
こうした時セルとセルの比較が必要になってくるのです。
何か書き方が悪くて内容が解かりにくかったかもしてません。すみません。

ichinoseさんへ
参考サンプル有難う御座います。
まだサンプルを見てどのように組み込もうかな?と考えている最中です。
それとこのサンプルの事なのですがあるセルの情報をmesに連結しているのですよね?
もしそうだとしたら比べたいもう一つのsampu2()を作成してsampu1()で作成したmesとsampu2()で作成したmesを比べればいいのですよね?

▼弘美 さん:
>弘美と申します。 こんにちわ(^^;
>早速ですがVBAでセルとセルの内容を比較する方法を調べています。
>内容だけならわかるのですがセルの内容全て(書式(網掛けの色とか文字色など)、コメントの有無、内容、)比較したいのです。
>どなたか教えてくださいませんか。 よろしくお願い致します。

【17047】Re:VBAでセルとセルの比較
回答  IROC  - 04/8/20(金) 13:28 -

引用なし
パスワード
   いまいち理解できません・・・

具体的にどのようなデータを
どのように修正しているのでしょうか?


なんかブックの使い方に問題があるような気もします。

【17082】Re:VBAでセルとセルの比較
発言  ichinose  - 04/8/21(土) 10:30 -

引用なし
パスワード
   ▼弘美 さん、皆さん、おはようございます。


>なぜセルとセルの比較をしたいのかと言うとお仕事で頻繁に皆が共有しているEXCELファイルがあるのですが修正していると他の人が使えなくなるので、そのEXCELファイルを自分のパソコンで修正して共有しているEXCELファイルに上書き保存をしたいのです。
>そうした時単純に上書き保存ができないのです。皆が使っているファイルの内容をその
>共有しているEXCELファイルに反映させなくてはいけないんです。そうした時プログラムを動かして皆が修正したファイルを集めてその内容を共有しているEXCELファイルに反映させそのデータを皆のEXCELファイルに戻す作業をしたいのです。
>こうした時セルとセルの比較が必要になってくるのです。

↑これで、何となくやりたいことは理解できましたが、まだ、何故、「セルとセルの比較」が必要なのかはわかりませんでした。
詳細がわからないので、めったなことは言えませんが、他の方法も検討するということも
残しておいてくださいね。
というのも、セルとセルの弘美 さんのいう全てのプロパティの比較と言うのは、
かなり面倒な処理ですよね?
こんな処理を本当にしなければならないのか?という疑問がどうしても
残ります。
仕様の根本的なところを再度見直す必要は無いか?なんて事を考えてみて下さいね!!


で、それはそれとして・・・・。

>まだサンプルを見てどのように組み込もうかな?と考えている最中です。
>それとこのサンプルの事なのですがあるセルの情報をmesに連結しているのですよね?
>もしそうだとしたら比べたいもう一つのsampu2()を作成してsampu1()で作成したmesとsampu2()で作成したmesを比べればいいのですよね?

MesというString型にしたのは、例としてMsgboxでの表示用文字列を編集するために
使用したものです。簡単な場合なら、これのvbTab やVbcrを除いて連結したものの比較でもよさそうですが、間違いも起こしそうですよ!!
例えば、弘美 さんの例にあった「コメントの有無やその内容」コメントが作成されていなければCommentプロパティでは、Nothingが返ってきます。
こんな場合は、どうするのかとかね!!
投稿したコードは、CallByNameを使用すれば、全てのプロパティを比較するコードより、
少しは簡単になるのではないかと言う例題コードという意味で記述したものです。

CallByNameを使用して、比較するには??でちょっと考えてみました。
前回のコードを少し変更して・・・・。

'======================================================================
Type att
  nestcnt As Long
  p_type() As Long 'p_nameが0:getメソッド 1:setメソッド _
              2:プロパティproperty get  8:オブジェクト
  p_name() As String 'プロパティ名
  End Type
'======================================================================
Type pr_pack
  ret() As Boolean 'true:プロパティを正常に取得 false:プロパティの取得不可
  ans() As Variant 'attの配列で取得したプロパティ falseは、の場合は取得不可
  End Type
'========================================================================
Sub main()
  Dim a1_pr As pr_pack
  Dim a2_pr As pr_pack
  Dim myPrName(1 To 7) As att
  myPrName(1) = set_att(Array(2), Array("numberFormatLocal"))
  myPrName(2) = set_att(Array(2), Array("value"))
  myPrName(3) = set_att(Array(8, 2), Array("Interior", "colorindex"))
  myPrName(4) = set_att(Array(8, 2), Array("Interior", "PatternColorIndex"))
  myPrName(5) = set_att(Array(8, 2), Array("Font", "colorindex"))
  myPrName(6) = set_att(Array(2), Array("Style"))
  myPrName(7) = set_att(Array(8, 8, 8, 1, 2), Array("comment", "shape", "textframe", "characters", "text"))
  a1_pr = get_property(Range("a1"), myPrName())
  a2_pr = get_property(Range("a2"), myPrName())
  ret = 0
  For i = 1 To 7
   If a1_pr.ret(i) = True And a2_pr.ret(i) = True Then
     If a1_pr.ans(i) <> a2_pr.ans(i) Then
      MsgBox Join(myPrName(i).p_name(), ".") & "が一致しません"
      ret = 1
      End If
   Else
     MsgBox Join(myPrName(i).p_name(), ".") & "が一致しません"
     ret = 1
     End If
   Next
  If ret = 0 Then
   MsgBox "比較したプロパティは一致します"
   End If
  End Sub
'==============================================================
Function set_att(type_array, nm_array) As att
'取得したいプロパティ情報をatt属性に設定する
'input : type_array プロパティ(メソッド)のタイプを表すVariantの配列
'     nm_array プロパティ(メソッド)の名前をVariantの配列
'output: set_att : get_propertyの入力データとなるatt属性のデータ

  With set_att
   .nestcnt = UBound(type_array) - LBound(type_array) + 1
   ReDim .p_type(1 To .nestcnt)
   ReDim .p_name(1 To .nestcnt)
   For idx = LBound(type_array) To UBound(type_array)
     .p_type(idx + 1) = type_array(idx)
     .p_name(idx + 1) = nm_array(idx)
     Next
   End With
End Function
'====================================================
Function get_property(myRange As Range, nmlst() As att) As pr_pack
'指定されたセルのnmlst()で設定されたプロパティを取得する
'input : myRange : プロパティを取得するセルオブジェクト
'    nmlst() : 取得するプロパティ名を含む情報群
'output: get_property---nmlst()に対応したプロパティの値を含むpr_pack属性

  Dim idx As Long
  Dim jdx As Long
  Dim obj As Object
  On Error Resume Next
  ReDim get_property.ans(1 To (UBound(nmlst()) - LBound(nmlst()) + 1))
  ReDim get_property.ret(1 To (UBound(nmlst()) - LBound(nmlst()) + 1))
  For idx = LBound(nmlst()) To UBound(nmlst())
    Set obj = myRange
    get_property.ret(idx) = True
    get_property.ans(idx) = Empty
    With nmlst(idx)
      For jdx = 1 To .nestcnt
       Err.Clear
       Select Case .p_type(jdx)
        Case 0
         get_property.ans(idx) = CallByName(obj, .p_name(jdx), VbMethod)
         If Err.Number = 0 Then Exit For
        Case 1
         Set obj = CallByName(obj, .p_name(jdx), VbMethod)
        Case 2
         get_property.ans(idx) = CallByName(obj, .p_name(jdx), VbGet)
         If Err.Number = 0 Then Exit For
        Case 8
         Set obj = CallByName(obj, .p_name(jdx), VbGet)
        End Select
       If Err.Number <> 0 Then
        get_property.ans(idx) = False
        get_property.ret(idx) = False
        Exit For
        End If
       Next jdx
      If IsEmpty(get_property.ans(idx)) Then
       Set get_property.ans(idx) = obj
       End If
      End With
   Next idx
   On Error GoTo 0
End Function


上記のコードのmainでは、アクティブシートのセルA1とA2を7つのプロパティで
比較したものです(一致か不一致のメッセージボックスを表示します)。
但し、まだ、追加コードが必要かもしれませんよ!!

CallByName関数を使用しても結構大変です。

【17083】Re:VBAでセルとセルの比較 訂正
発言  ichinose  - 04/8/21(土) 12:16 -

引用なし
パスワード
   Mainプロシジャーだけちょっと訂正です。
'=====================================================
Sub main()
  Dim a1_pr As pr_pack
  Dim a2_pr As pr_pack
  Dim myPrName(1 To 7) As att
  myPrName(1) = set_att(Array(2), Array("numberFormatLocal"))
  myPrName(2) = set_att(Array(2), Array("value"))
  myPrName(3) = set_att(Array(8, 2), Array("Interior", "colorindex"))
  myPrName(4) = set_att(Array(8, 2), Array("Interior", "PatternColorIndex"))
  myPrName(5) = set_att(Array(8, 2), Array("Font", "colorindex"))
  myPrName(6) = set_att(Array(2), Array("Style"))
  myPrName(7) = set_att(Array(8, 8, 8, 1, 2), Array("comment", "shape", "textframe", "characters", "text"))
  a1_pr = get_property(Range("a1"), myPrName())
  a2_pr = get_property(Range("a2"), myPrName())
  ret = 0
  For i = 1 To 7
   If a1_pr.ret(i) = a2_pr.ret(i) Then
     If a1_pr.ret(i) = True Then
      If a1_pr.ans(i) <> a2_pr.ans(i) Then
        MsgBox Join(myPrName(i).p_name(), ".") & "が一致しません"
        ret = 1
        End If
      End If
   Else
     MsgBox Join(myPrName(i).p_name(), ".") & "が一致しません"
     ret = 1
     End If
   Next
  If ret = 0 Then
   MsgBox "比較したプロパティは一致します"
   End If
  End Sub

【17166】Re:VBAでセルとセルの比較
発言  弘美  - 04/8/24(火) 14:27 -

引用なし
パスワード
   こんにちわ(^^; 弘美です。
書き方が判りにくかったみたいですね。すみません。
もっと詳しく書くと共有ファイルを自分のパソコンにもってきて修正するのですが
修正する人たちは現在最大で7人います。それで朝共有ファイルを修正する人たちに
転送して修正してそれを共有ファイルに戻す処理を作成います。
そうした時同じレコード(行)を複数の人が修正した場合どちらのデータを優先するのかが決まりがあります。例えば
   担当  データ              データ       データ
   Aさん あいうえお → これを  Aさん かきくけこ Bさん さしすせそ 
と修正した場合この場合はデータの担当者がAさんなのでAさんのデータで上書き
します。Aさんが修正していなかった場合はBさんのデータで上書きします。
(AさんのデータをBさんも修正できる仕様)
そうした時プログラムの中で処理する順番が
     A
     B     
     C
の順になっていた場合Bさんのデータで上書きされてしまいます。
それでは困るのでAさんが修正したのかをチェックしてAさんがどこか修正していた場合はAさんのデータを上書きにして修正していなかった場合はBさんのデータを上書き
しようと思ったのです。始めは行ごとの更新なのでタイムスタンプを入れて判断
するか、(因みにタイムスタンプっていれられるのかな?)もし修正したかがわかる印をいれてもらって判断しようと思ったのですが2つとも却下されてしまったのです。それでセルごとにチェックするしかない思ったのです。
でもセルとセルを比較するには大変だし列や行がたくさんあった場合はかなり時間がかかると思うしいろいろと方法を考えているのですが、なかなかいい案がみつかりません。
やっぱり比較するしかないかなぁ...
なにかいい案があったら教えて下さい。 お願します。

【17167】Re:VBAでセルとセルの比較
回答  IROC  - 04/8/24(火) 14:47 -

引用なし
パスワード
   >なにかいい案があったら教えて下さい。 お願します。

Accessに変更するのが良いかと思います。

【17245】Re:VBAでセルとセルの比較
お礼  弘美  - 04/8/25(水) 13:57 -

引用なし
パスワード
   こんにちわ(^^; 弘美です。

いろいろ考えたのですがACCESSだと網掛けとかの情報が出来ないし、EXCELのが使いかってがいいとの事でvbで作成する事にしました。
ichinoseさんが提供してくれたサンプルプログラムを使わせていただきます。
みなさんいろいろと有難う御座いました。

>

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