Excel VBA質問箱 IV

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

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


21 / 13171 ツリー ←次へ | 前へ→

【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 お礼[未読]

【80045】1つのリストから同じブック内に複数明細...
質問  さくらこ  - 18/7/14(土) 14:58 -

引用なし
パスワード
   教えてください。
Excel2016を使っています。
1つのブックのsheet1に受注リストが、sheet2に出荷明細のフォームがあります。
受注リストには、20列100行ほどのデータがあり、3行目まではタイトル行で4行目から下にデータがあります。「100行ほど」と書きましたが、データ量は都度更新します。
月に一度、A列受注No・B列管理No・F列品名・H列数量・S列注文者氏名 の5つのデータを、B列管理No ごとに出荷明細としてシートに生成したいのです。
出荷明細のフォームを複製して、管理Noをシート名に指定し、下記値を代入していくイメージです。
・セルA3=S列注文者氏名
・セルB5=A列受注No
・セルA25〜セルA32=F列品名※複数品名のケースあり
・セルH25〜セルH32=H列数量※品名ごとの数量
・セルB34=B列管理No
※1つの管理Noに対して複数品名ある場合、数量はもちろん品名ごとに異なりますが、A列受注No・B列管理No・S列注文者氏名 は同じ情報が複数行に入っています

毎月手作業で複数明細を作成していますが、効率化のために自動化したく、ご相談させていただきました。
何卒よろしくお願いいたします。

【80048】Re:1つのリストから同じブック内に複数明...
発言  γ  - 18/7/14(土) 19:51 -

引用なし
パスワード
   コードを作成してください、ということですか?
ご自分でできているところを示して、
不明点、詰まっているところを具体的に質問したほうが
よいと思いますよ。

【80050】Re:1つのリストから同じブック内に複数明...
発言  さくらこ  - 18/7/14(土) 22:58 -

引用なし
パスワード
   すいません、ごもっともです。
知識が乏しすぎて、手も足も出ない状況で、頼ってしまいました…
時間はかかると思いますが、調べて、コードを書いてみます。
不明点があれば、また質問させていただきたいと思います。
よろしくお願いいたします。

【80051】Re:1つのリストから同じブック内に複数明...
発言  γ  - 18/7/15(日) 14:55 -

引用なし
パスワード
   まずは、他の回答者からの回答をお待ちください。


もしご自身でトライされるのであれば、以下を参考にして下さい。

大ざっぱに要約すると、
(1)重複のない"管理No"の一覧を作成して、
(2)そのひとつひとつの管理Noに対してシートを作成して、
  所定のデータを書き込む
ということかと思います。

それぞれ、こんな方向で考えたらよいのではないでしょうか。
(1)はフィルタオプションを使ってはどうでしょうか。
 「重複レコードを無視」して別の領域にいったん抽出します。
  といっても手作業でやって下さいと言うことではなく、
  そのマクロ記録をとれば、コードが得られるでしょうということです。

(2)は、オートフィルタを使って、"管理No"に該当するデータのみ抽出します。
  抽出したデータをもとに転記をすればよいと思います。

【80052】Re:1つのリストから同じブック内に複数明...
お礼  さくらこ  - 18/7/15(日) 15:18 -

引用なし
パスワード
   アドバイスありがとうございます。
(1)については、マクロ記録でできました。
それ以降の処理について、似たようなコードを参考にしようとしているのですが、なかなか難しく、苦戦中です。
でも、やろうとしている順序が間違ってはいなかったようなので、引き続き頑張ります。

【80054】Re:1つのリストから同じブック内に複数明...
お礼  さくらこ  - 18/7/16(月) 2:20 -

引用なし
パスワード
   アドバイス頂いた方法とは少し違うかもしれませんが、色々なサイト情報を参考に、一旦はなんとか目的の動作をするマクロが作れました。
これまで、VBAは既存のコードの部分修正程度しかしたことがありませんでしたが、こちらのサイトをはじめ、様々な情報がとても参考になりました。
お作法もなっていないめちゃくちゃな記述かもしれませんが、ひとまずこれで使ってみようと思います。
また何か困ったことがあれば、相談させてください。
この度は、ありがとうございました。

----------
Sub 明細シート作成()

wsList.Select
Range("A4:A200").Select
Selection.Copy
wsClient.Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
wsList.Select
Range("C4:C200").Select
Selection.Copy
wsClient.Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues
wsList.Select
Range("S4:S200").Select
Selection.Copy
wsClient.Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$C$197").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
wsList.Select
Range("A1").Select

Dim rowsList As Long, rowsClient As Long
rowsList = wsList.Cells(Rows.Count, 1).End(xlUp).Row
rowsClient = wsClient.Cells(Rows.Count, 1).End(xlUp).Row

Dim n As Long
For n = 1 To rowsClient

  Dim txt As String, no As String, name As String, i As Long, k As Long
  txt = wsClient.Cells(n, 1).Value
  no = wsClient.Cells(n, 2).Value
  name = wsClient.Cells(n, 3).Value
  k = 25
  wsForm.Copy After:=wsForm
  ActiveSheet.name = txt
  ActiveSheet.Range("B34").Value = txt
  ActiveSheet.Range("B5").Value = no
  ActiveSheet.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
----------

【80055】Re:1つのリストから同じブック内に複数明...
発言  γ  - 18/7/16(月) 7:21 -

引用なし
パスワード
   頑張られましたね。すごいです。
スキルアップになったことと推察いたします。

老婆心ながら、すこし体裁を整えてみました。
参考にしてください。

なお、冒頭に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

【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

 

【80059】Re:1つのリストから同じブック内に複数明...
お礼  さくらこ  - 18/7/16(月) 13:19 -

引用なし
パスワード
   詳細にご教示いただき、ありがとうございます。
Option Explicitやオートフィルタの使い方など、とても勉強になります!
今回試行錯誤してみて、一歩踏み出せたと思うので、これからも続けて勉強しようと思います。
教えていただいたコードも、しっかり確認して、使えるようにします!
またつまずいた時はアドバイス求めてこちらに質問させてください。
よろしくお願いいたします。
本当にありがとうございました!!

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