| |
▼弘美 さん、皆さん、おはようございます。
。
>なぜセルとセルの比較をしたいのかと言うとお仕事で頻繁に皆が共有しているEXCELファイルがあるのですが修正していると他の人が使えなくなるので、そのEXCELファイルを自分のパソコンで修正して共有しているEXCELファイルに上書き保存をしたいのです。
>そうした時単純に上書き保存ができないのです。皆が使っているファイルの内容をその
>共有しているEXCELファイルに反映させなくてはいけないんです。そうした時プログラムを動かして皆が修正したファイルを集めてその内容を共有しているEXCELファイルに反映させそのデータを皆のEXCELファイルに戻す作業をしたいのです。
>こうした時セルとセルの比較が必要になってくるのです。
↑これで、何となくやりたいことは理解できましたが､まだ、何故、「セルとセルの比較」が必要なのかはわかりませんでした。
詳細がわからないので、めったなことは言えませんが、他の方法も検討するということも
残しておいてくださいね。
というのも、セルとセルの弘美 さんのいう全てのプロパティの比較と言うのは、
かなり面倒な処理ですよね？
こんな処理を本当にしなければならないのか？という疑問がどうしても
残ります。
仕様の根本的なところを再度見直す必要は無いか？なんて事を考えてみて下さいね！！
で、それはそれとして・・・・。
>まだサンプルを見てどのように組み込もうかな？と考えている最中です。
>それとこのサンプルの事なのですがあるセルの情報をｍｅｓに連結しているのですよね？
>もしそうだとしたら比べたいもう一つのsampu2()を作成してsampu1()で作成したｍｅｓとsampu2()で作成したｍｅｓを比べればいいのですよね？
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関数を使用しても結構大変です。
|
|
ichinose
- 04/8/21(土) 10:30 -
