Excel VBA質問箱 IV

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

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


64237 / 76738 ←次へ | 前へ→

【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関数を使用しても結構大変です。
0 hits

【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 お礼

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