| |
先日はありがとうございました。
順調だったのですが、疑問点が２つ出てきました。
1.業者がＡ・Ｃ社となっているものがあったのです。
これを入力すると、当然その他のセルに○がついてしまいます。
これをできれば、ＡとＣの両方に○を付けたいのです。
どのようにすればいいか、アドバイスをお願いできませんか？
2.シート３（様式）は１０行までしかありません。
１１行目以降になることも考えられたため、下記のようなマクロに変更しました。
IF〜Else Do Untilを使って、１０品目までをまず印刷し、
１１品目からはシート２に再度張りなおしてシート３に表しています。
ところが２枚目以降になると、オートシェイプの位置がずれてしまいます。
何が悪いのでしょうか。
分かりましたら教えてください。
Dim dic As Object
Dim dic2 As Object
Dim c As Range
Dim i As Long
Dim ss As String
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
For Each c In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
dic(c.Value) = c.Offset(, 3).Value
Next
End With
With Sheets("Sheet3")
For Each c In .Range("F1").Resize(2, 2)
If Len(c.Value) > 0 Then
i = i + 1
dic2(c.Value) = i
End If
Next
.Ovals.Delete
For Each c In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
If Len(c.Value) > 0 Then
If dic.Exists(c.Value) Then
ss = dic(c.Value)
If dic2.Exists(ss) Then
i = dic2(ss)
Else
i = dic2.Count
End If
drawCircle c.Offset(, 3).Resize(2, 2).Item(i)
End If
End If
Next
End With
Set dic = Nothing
Set dic2 = Nothing
Sheets("Sheet3").PrintOut
If Sheets("Sheet2").Range("C11") = "" Then
Sheets("Sheet3").Select
Else
Do Until Sheets("Sheet2").Range("C11").Value = ""
Sheets("Sheet2").Rows("11:65536").Copy
Sheets("Sheet2").Rows("1:1").PasteSpecial
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
For Each c In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
dic(c.Value) = c.Offset(, 3).Value
Next
End With
With Sheets("Sheet3")
For Each c In .Range("F1").Resize(2, 2)
If Len(c.Value) > 0 Then
i = i + 1
dic2(c.Value) = i
End If
Next
.Ovals.Delete
For Each c In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
If Len(c.Value) > 0 Then
If dic.Exists(c.Value) Then
ss = dic(c.Value)
If dic2.Exists(ss) Then
i = dic2(ss)
Else
i = dic2.Count
End If
drawCircle c.Offset(, 3).Resize(2, 2).Item(i)
End If
End If
Next
End With
Set dic = Nothing
Set dic2 = Nothing
Sheets("Sheet3").PrintOut
Loop
Sheets("Sheet3").Select
End If
End Sub
大変分かりにくいかもしれません。
よろしくお願いします。
|
|
どぢょりん
- 11/11/19(土) 8:22 -
