Excel VBA質問箱 IV

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

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


211 / 74623 ←次へ | 前へ→

【80056】Re:1つのリストから同じブック内に複数明細を生成したい
発言  γ  - 18/7/16(月) 7:33 -

引用なし
パスワード
   フィルタオプションとオートフィルタを使った、私案を参考までに示します。

なお、フィルタオプションを使う関係で、見出しが必須です。
・ListシートのA3,C3,F3,F3,S3には項目見出しを入れます。
・ClientシートのA1,B1,C1にも見出しを、
 それぞれListシートのA3,C3,S3と全く同一のものを記入してください。

Sub 明細シート作成3()
  Dim wsList   As Worksheet
  Dim wsClient  As Worksheet
  Dim wsForm   As Worksheet
  Dim ws     As Worksheet
  
  Dim lastRow   As Long
  Dim myRange   As Range
  Dim myBody   As Range
  Dim r      As Range

  Dim rowsClient As Long
  Dim n      As Long
  Dim txt     As String
  Dim no     As String
  Dim name    As String
  Dim k      As Long

  Set wsList = Worksheets("List")
  Set wsClient = Worksheets("Client")
  Set wsForm = Worksheets("Form")

  'フィルタ範囲の指定
  lastRow = wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row
  Set myRange = wsList.Range(wsList.Cells(3, "A"), wsList.Cells(lastRow, "S"))
  
  'その本体部分(つまり見出しを除いた部分)
  Set myBody = Intersect(myRange, myRange.Offset(1))

  '重複を除いて抽出
  myRange.AdvancedFilter Action:=xlFilterCopy, _
              CopyToRange:=wsClient.Range("A1:C1"), Unique:=True

  '転記
  rowsClient = wsClient.Cells(wsClient.Rows.Count, 1).End(xlUp).Row
  For n = 2 To rowsClient
    txt = wsClient.Cells(n, 1).Value  '受注No
    no = wsClient.Cells(n, 2).Value   '管理No
    name = wsClient.Cells(n, 3).Value  '注文者氏名

    '管理No 毎のシートを作成
    wsForm.Copy After:=Worksheets(Worksheets.Count)
    Set ws = ActiveSheet
    ws.name = txt

    '固定項目の転記
    ws.Range("B34").Value = txt
    ws.Range("B5").Value = no
    ws.Range("A3").Value = name

    '管理Noを指定して抽出(品目毎データの転記用)
    myRange.AutoFilter Field:=3, Criteria1:=no

    'その転記
    k = 25
    For Each r In myBody.Columns(1).SpecialCells(xlCellTypeVisible)
      ws.Cells(k, 1) = r.Cells(1, 6).Value
      ws.Cells(k, 8) = r.Cells(1, 8).Value
      k = k + 1
    Next
  Next
  myRange.AutoFilter
End Sub

 

67 hits

【80045】1つのリストから同じブック内に複数明細を生成したい さくらこ 18/7/14(土) 14:58 質問[未読]
【80048】Re:1つのリストから同じブック内に複数明細... γ 18/7/14(土) 19:51 発言[未読]
【80050】Re:1つのリストから同じブック内に複数明細... さくらこ 18/7/14(土) 22:58 発言[未読]
【80051】Re:1つのリストから同じブック内に複数明細... γ 18/7/15(日) 14:55 発言[未読]
【80052】Re:1つのリストから同じブック内に複数明細... さくらこ 18/7/15(日) 15:18 お礼[未読]
【80054】Re:1つのリストから同じブック内に複数明細... さくらこ 18/7/16(月) 2:20 お礼[未読]
【80055】Re:1つのリストから同じブック内に複数明細... γ 18/7/16(月) 7:21 発言[未読]
【80056】Re:1つのリストから同じブック内に複数明細... γ 18/7/16(月) 7:33 発言[未読]
【80059】Re:1つのリストから同じブック内に複数明細... さくらこ 18/7/16(月) 13:19 お礼[未読]

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