| |
▼どぢょりん さん：
>Sheet3 のデータは Sheet2とリンクしています。
>Sheet3 の各行の「仕入先」は（現在は 記入されていないけれど）
> Sheet2を見れば分かります。
> たとえば、
>Sheet3の 1行目の仕入れ先は Sheet2の 1行目のデータです。
>Sheet3の 3行目の仕入れ先は Sheet2の 2行目のデータです。
>Sheet3の 5行目の仕入れ先は Sheet2の 3行目のデータです。
>以下同様。
このことを利用すると、たとえばですが、以下とか？
Sub 仕入先に○_印刷3()
Dim c As Range, cLast As Range, r As Range
Dim i As Long
Dim y As Long
Dim ss As String, s1 As String
Dim WS2 As Worksheet: Set WS2 = Worksheets(2)
Dim WS3 As Worksheet: Set WS3 = Worksheets(3)
With WS3
.Select
Do Until IsEmpty(WS2.Range("B1").Value)
.DrawingObjects.Delete
For y = 1 To 20 Step 2
If Len(.Cells(y, "C").Text) = 0 Then Exit For
ss = WS2.Cells((y + 1) \ 2, "F").Value 'Sheet2仕入先文字列
Set r = .Cells(y, "F").Resize(2, 2)
For Each c In r
s1 = c.Value
If InStr(ss, s1) Then
drawCircle c
ss = Replace(ss, s1, "")
If Len(ss) = 0 Then Exit For
End If
Next
If Len(ss) > 0 Then
If Len(Replace(ss, "・", "", Compare:=vbTextCompare)) > 0 Then
drawCircle r.Item(r.Count)
End If
End If
Next
'仕入先の円囲みが終わったら、印刷
.PrintPreview 'デバッグのため プレビュー
'.PrintOut ’本来は こちら
'印刷が終わったら WS2のデータを上方向シフト
With WS2.Range("A1")
.CurrentRegion.Offset(10).Copy .Cells
End With
Loop
End With
End Sub
|
|
kanabun
- 11/11/20(日) 16:22 -
