| |
頑張られましたね。すごいです。
スキルアップになったことと推察いたします。
老婆心ながら、すこし体裁を整えてみました。
参考にしてください。
なお、冒頭にOption Explicitを入れることをお薦めします。
こうすると、未宣言の変数には警告が出されます。
このことによって思わぬミスタイプを防止することができます。
これを付けないばかりにデバッグに相当な時間がかかってしまうことがあります。
（なお、
ツール − オプション − 編集 で
「変数の宣言を強制する」にチェックを入れておけば、
モジュールを作成した時点で、Option Explicitが自動的に挿入されるので、
手間が省けます。
一度だけチェックを入れておけば、以後、気にする必要はありません。）
Option Explicit
Sub 明細シート作成2()
Dim wsList As Worksheet
Dim wsClient As Worksheet
Dim wsForm As Worksheet
Dim ws As Worksheet
Dim rowsList As Long, rowsClient As Long
Dim n As Long
Dim txt As String, no As String, name As String
Dim i As Long, k As Long
Set wsList = Worksheets("List")
Set wsClient = Worksheets("Client")
Set wsForm = Worksheets("Form")
wsList.Range("A4:A200").Copy
wsClient.Range("A1").PasteSpecial Paste:=xlPasteValues
wsList.Range("C4:C200").Copy
wsClient.Range("B1").PasteSpecial Paste:=xlPasteValues
wsList.Range("S4:S200").Copy
wsClient.Range("C1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wsClient.Range("$A$1:$C$197").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
wsList.Select
Range("A1").Select
rowsList = wsList.Cells(Rows.Count, 1).End(xlUp).Row
rowsClient = wsClient.Cells(Rows.Count, 1).End(xlUp).Row
For n = 1 To rowsClient
txt = wsClient.Cells(n, 1).Value
no = wsClient.Cells(n, 2).Value
name = wsClient.Cells(n, 3).Value
k = 25
wsForm.Copy After:=wsForm
Set ws = ActiveSheet
ws.name = txt
ws.Range("B34").Value = txt
ws.Range("B5").Value = no
ws.Range("A3").Value = name
For i = 4 To rowsList
If wsList.Cells(i, 1).Value = txt Then
wsList.Cells(i, 6).Copy ActiveSheet.Cells(k, 1)
wsList.Cells(i, 8).Copy ActiveSheet.Cells(k, 8)
k = k + 1
End If
Next i
Next n
End Sub
|
|
γ
- 18/7/16(月) 7:21 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
