Excel VBA質問箱 IV

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

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


995 / 13645 ツリー ←次へ | 前へ→

【76983】【VBA】不特定数データを検索したシートに足し込み Haruka 15/4/24(金) 11:10 質問[未読]
【76984】Re:【VBA】不特定数データを検索したシート... 独覚 15/4/24(金) 11:20 発言[未読]
【76985】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/24(金) 11:27 回答[未読]
【76986】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 11:48 発言[未読]
【76987】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 14:07 発言[未読]
【76988】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/24(金) 16:23 発言[未読]
【76990】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 18:00 発言[未読]
【76991】Re:【VBA】不特定数データを検索したシート... β 15/4/24(金) 19:32 発言[未読]
【76992】Re:【VBA】不特定数データを検索したシート... β 15/4/25(土) 6:23 発言[未読]
【76993】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/27(月) 9:23 発言[未読]
【76994】Re:【VBA】不特定数データを検索したシート... β 15/4/27(月) 9:43 発言[未読]
【76995】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/27(月) 15:04 質問[未読]
【76996】Re:【VBA】不特定数データを検索したシート... β 15/4/27(月) 15:52 発言[未読]
【76997】Re:【VBA】不特定数データを検索したシート... β 15/4/28(火) 7:21 発言[未読]
【76998】Re:【VBA】不特定数データを検索したシート... Haruka 15/4/28(火) 10:26 お礼[未読]

【76983】【VBA】不特定数データを検索したシート...
質問  Haruka  - 15/4/24(金) 11:10 -

引用なし
パスワード
   マクロ初心者です。下記の内容についてマクロを組んでみたのですが、どうしても5.で止まってしまい、6.の作業に移行しません。説明が不十分かもしれませんが、アドバイス頂けると助かります。

"元データ"A列2行目に地域コード、3行目以降に不特定数の商品コードが記入されている。
B列は商品名で、CDE列は販売数量・売上高・粗利が記入されており、このパターンが不特定数繰り返される。
"元データ"のA列は、1つの地域データの後に空白セルが1つあり、その後に次の地域コードがある。
元データシート以降に各地域毎のシートがあり、シート名は地域名になっている(以後地域シート)。
*地域シートはいくつかの地域コードを含む場合がある
"地域シート"はA列に商品コード、それ以降の列は7行目から月毎の販売数量・売上高・粗利を記入する。"地域シート"の構成は全て同じ。
その時によって記入したい時期が変わるので、"元データ"H列に記入された対象時期の数値で時期を判別。
H列の対象時期の数値は"地域シート"の3行目に時期毎に記入されている(Ex.10月→10)

<元データシート>
     A列    B列    C列    D列  E列   F列  G列  H列
01行目 記録日  商品名   販売数量 売上高 粗利益 (空白) 時期 102
02行目 1058   ABC USA Inc 
03行目 7001   りんご    2    2500  1000
04行目 7002   みかん    5    5500  3000
05行目 7003   バナナ    4    3500  1500
06行目 (空白セル)
07行目 1003   DEC China
08行目  901   サバ     2    2500  1000
09行目  902   さんま    5    5500  3000

<地域シート>
     A列  B列     C列    D列  E列   F列  G列  H列
01行目 (空白) 販売実績   北米   (空白)  
02行目 (空白) ABC USA Inc
03行目 (空白) (空白)   (空白)   102
04行目 (空白) (空白)   (空白)   9月
05行目 (空白) コード 商品名  
06行目 (空白)             数量    売上金額    粗利額
07行目 7001  E7001  りんご     2   2500  1000
08行目 7002  E7002  みかん     5   5500  3000
09行目 7003  E7003  バナナ     4   3500  1500

<やりたいこと>
1.:"元データ"の地域コードから該当する"地域シート"名を判別
2.:"元データ"H列の対象時期で"地域シート"の記入場所を判別。
3.:"地域シート"A列の商品コードと、"元データ"A列のコードが一致したら"地域シート"に販売数・売上高・粗利を貼り付ける
4.:3.の作業を"元データ"A列のセルが空白になるまで繰り返し
5.:"元データ"の次のデータに移行し、1.から繰り返し
6.:"元データ"のB列が空白になるまで繰り返し

5.で止まる時は元データの5行目のコピー&ペーストまで行い、自動的に
終了してしまいます。終了した時点では、ペーストしたセルがアクティブに
なっており、次の得意先コードに移行していない様子です。5.の時点でのmの値は
6なので、なぜ次の地域コードに移行しないのか分かりません。

Sub データ入力マクロ()

  Dim ws As Worksheet

  i = 2
  m = 2

  Application.ScreenUpdating = False

Step1:
  
  Worksheets("元データ").Select

'  1.地域シートの検索と定義づけ
    
    Select Case Cells(i, 1)
    
      Case 1085, 1091, 1103, 1039, 1132
      Set ws = Worksheets("America")

      Case 1230
      Set ws = Worksheets("China")
    
      Case Else
      MsgBox ("該当する代理店がありません")
    
    End Select

'  2.データを入れる期間の検索

  cnt = Worksheets("元データ").Range("H" & 1).Value

  ws.Select
  
  d = ws.Range("A3:HS3").Find(cnt).Column
  
'  3.商品コードでデータを検索 該当セルに貼り付け

  Do Until Sheets("元データ").Range("A" & m) = ""
 
  Sheets("元データ").Select
  
  For y = 7 To 210
    
    If Worksheets("元データ").Range("A" & m).Value = ws.Range("A" & y).Value Then
 
    Sheets("元データ").Select
    Range("C" & m, "E" & m).Copy
    ws.Select
    Cells(y, d).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, _
    SkipBlanks:=False, Transpose:=False

  End If
 
  Next y
 
'  4.元データの次の行を検索
 
  m = m + 1
 
  Loop
      
'  5.次の地域コードに移行

  If Sheets("元データ").Cells(m, 1) = "" Then
  m = m + 1
  i = m

  End If

'  6.元データのB列が空白セルになるまで繰り返し
  
  c = Range("B1").End(xlDown).Row
  Do While m < c
  
  GoTo Step1

  Loop


End Sub

以上です。
こちらでは初めての質問で、分かり辛いかと思いますがご助言頂ければ
本当に助かります。どうぞ宜しくお願い致します。

【76984】Re:【VBA】不特定数データを検索したシー...
発言  独覚  - 15/4/24(金) 11:20 -

引用なし
パスワード
   ▼Haruka さん:
こちらの掲示板の基本方針です。

>別のサイト(掲示板)にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。
>当質問箱では、マルチポストは原則認めています。
>つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。

>しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。
>そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。
>質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。

>また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。

【76985】Re:【VBA】不特定数データを検索したシー...
回答  Haruka  - 15/4/24(金) 11:27 -

引用なし
パスワード
   ▼独覚 さん:
ご指摘ありがとうございました。初めての投稿で失礼をしてしまい、
本当に申し訳ありませんでした。こちらの質問は現在Yahoo!知恵袋に
投稿しております。1つ御回答をいただいたのですが、現時点では
問題の解決に至っておりません。

知恵袋とこちらのサイトでの質問の併用は禁止事項に該当しますでしょうか?
もしそうでしたら、知恵袋の方の質問を取り下げます。

初心者でご迷惑をお掛けし、本当に申し訳ありません。
仕事の締め切りが迫っており、質問させていただいた次第です。

ご助言頂ければ本当に助かります。
宜しくお願い致します。

【76986】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/24(金) 11:48 -

引用なし
パスワード
   ▼Haruka さん:

こんにちは

>知恵袋とこちらのサイトでの質問の併用は禁止事項に該当しますでしょうか?
>もしそうでしたら、知恵袋の方の質問を取り下げます。

いえいえ。独覚 さんがアップされた質問箱のポリシーを読んでいただければわかる通り
マルチポストは禁止はしていないですね。(知恵袋もそうですね)

ただ、「マナー」として、どこそこにも質問しています ということを明示いただくことと
いずれかで解決した場合、もういいやではなく、別途質問している掲示板にも
どこどこで、どういったような内容で解決しましたと 報告をアップして閉じる。
そういったことが望まれますね。

知恵袋のほうは、結構、多くの回答がよせられると聞いていますので閉じるのは
もったいないと思いますよ。

【76987】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/24(金) 14:07 -

引用なし
パスワード
   ▼Haruka さん:

>>3.:"地域シート"A列の商品コードと、"元データ"A列のコードが一致したら"地域シート"に販売数・売上高・粗利を貼り付ける

貼り付けですね?加算じゃなく。
で、もし、商品が地域シートに記入されていなければ空振りですか?
それとも最終行に追加ですか?

【76988】Re:【VBA】不特定数データを検索したシー...
発言  Haruka  - 15/4/24(金) 16:23 -

引用なし
パスワード
   ▼β さん:
>▼Haruka さん:
>
>>>3.:"地域シート"A列の商品コードと、"元データ"A列のコードが一致したら"地域シート"に販売数・売上高・粗利を貼り付ける
>
>貼り付けですね?加算じゃなく。
>で、もし、商品が地域シートに記入されていなければ空振りですか?
>それとも最終行に追加ですか?

βさん

ご質問有難うございます!
すみません、貼り付けでなく加算です。1つの地域シートに複数の地域コードが
含まれる場合があるためです。
あと、地域シートに商品が記入されていないというケースは無い前提です、
元データシートの商品分類は、必ず地域シートのどれかに該当するように
なっています。

御覧頂いて本当に有難うございます。ご助言頂けると嬉しいです!

【76990】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/24(金) 18:00 -

引用なし
パスワード
   ▼Haruka さん:

以下で試してみてください。

Sub Test()
  Dim bs As Worksheet
  Dim ws As Worksheet
  Dim mRow As Long
  Dim i As Long
  Dim Break As Boolean
  Dim dist As Variant
  Dim cnt As Variant
  Dim com As Variant
  Dim qty As Long
  Dim amt As Long
  Dim pl As Long
  Dim col As Variant
  Dim z As Variant
  
  Application.ScreenUpdating = False
  
  Set bs = Sheets("元データ")
  mRow = bs.Range("A" & Rows.Count).End(xlUp).Row   '元データ最終行番号
  Break = True          '最初の行は地域データ
  cnt = bs.Range("H1").Value   '月コード
  
  For i = 2 To mRow
    If Break Then  '地域コード行
      dist = bs.Cells(i, "A").Value
      Select Case dist
        Case 1085, 1091, 1103, 1039, 1132
          Set ws = Worksheets("America")
        Case 1230
          Set ws = Worksheets("China")
        Case Else
          MsgBox "(" & dist & ") 該当する代理店がありません"
          Set ws = Nothing
      End Select
      Break = False
      If Not ws Is Nothing Then
        '地域シートの3行目で月コードの存在する列番号を取得
        col = Application.Match(cnt, ws.Range("A1", ws.UsedRange).Rows(3), 0)
        If IsError(col) Then
          MsgBox "(" & cnt & ")月コードが" & ws.Name & "にないのでスキップします"
          Set ws = Nothing
        End If
      End If
    Else
      If IsEmpty(bs.Cells(i, "A")) Then    '地域データの間の空白行
        Break = True            '次の行は地域データ
      Else                  '通常のデータ行
        Break = False
        If Not ws Is Nothing Then      '地域シートが存在する場合のみ対象
          com = bs.Cells(i, "A").Value  '商品コード
          qty = bs.Cells(i, "C").Value  '数量
          amt = bs.Cells(i, "D").Value  '金額
          pl = bs.Cells(i, "E").Value   '利益
          '地域シートの該当商品コードの行を取得
          z = Application.Match(com, ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)), 0)
          If IsError(z) Then
            MsgBox "(" & com & ")商品コードが" & ws.Name & "にないのでスキップします"
          Else
            ws.Cells(z, "D").Value = ws.Cells(z, "D").Value + qty
            ws.Cells(z, "E").Value = ws.Cells(z, "E").Value + amt
            ws.Cells(z, "F").Value = ws.Cells(z, "F").Value + pl
          End If
        End If
      End If
    End If
  
  Next i
  
End Sub

【76991】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/24(金) 19:32 -

引用なし
パスワード
   ▼Haruka さん:

ごめんなさい
 
ws.Cells(z, "D").Value = ws.Cells(z, "D").Value + qty
ws.Cells(z, "E").Value = ws.Cells(z, "E").Value + amt
ws.Cells(z, "F").Value = ws.Cells(z, "F").Value + pl

これを

ws.Cells(z, col).Value = ws.Cells(z, col).Value + qty
ws.Cells(z, col + 1).Value = ws.Cells(z, col + 1).Value + amt
ws.Cells(z, col + 2).Value = ws.Cells(z, col + 2).Value + pl

にしてください。

【76992】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/25(土) 6:23 -

引用なし
パスワード
   ▼Haruka さん:

すこしわかりにくいかもしれませんが、地域ごとのブロック取得を別方式で。
各行の各項目の扱いも記述方式をかえてみました。

Sub Test2()
  Dim bs As Worksheet
  Dim ws As Worksheet
  Dim Break As Boolean
  Dim dist As Variant
  Dim cnt As Variant
  Dim com As Variant
  Dim qty As Long
  Dim amt As Long
  Dim pl As Long
  Dim col As Variant
  Dim z As Variant
  Dim allAreas As Range
  Dim myArea As Range
  Dim c As Range
  
  Application.ScreenUpdating = False
  
  Set bs = Sheets("元データ")
  cnt = bs.Range("H1").Value   '月コード
  'A列から地域コードごとの領域を分割して一挙取得
  Set allAreas = bs.Range("A2", bs.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
  For Each myArea In allAreas.Areas  '個々の地域コード領域を取り出す
    Break = True          '最初の行は地域データ
    For Each c In myArea      '各データ行
      If Break Then  '地域コード行
        dist = c.Value
        Select Case dist
          Case 1085, 1091, 1103, 1039, 1132
            Set ws = Worksheets("America")
          Case 1230
            Set ws = Worksheets("China")
          Case Else
            MsgBox "(" & dist & ") 該当する代理店がありません"
            Set ws = Nothing
        End Select
        Break = False
        If Not ws Is Nothing Then
          '地域シートの3行目で月コードの存在する列番号を取得
          col = Application.Match(cnt, ws.Range("A1", ws.UsedRange).Rows(3), 0)
          If IsError(col) Then
            MsgBox "(" & cnt & ")月コードが" & ws.Name & "にないのでスキップします"
            Set ws = Nothing
          End If
        End If
      Else
        Break = False
        If Not ws Is Nothing Then      '地域シートが存在する場合のみ対象
          With c.EntireRow
            com = .Range("A1").Value  '商品コード
            qty = .Range("C1").Value  '数量
            amt = .Range("D1").Value  '金額
            pl = .Range("E1").Value   '利益
          End With
          '地域シートの該当商品コードの行を取得
          z = Application.Match(com, ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)), 0)
          If IsError(z) Then
            MsgBox "(" & com & ")商品コードが" & ws.Name & "にないのでスキップします"
          Else
            With ws.Cells(z, col - 3)
              .Range("D1").Value = .Range("D1").Value + qty
              .Range("E1").Value = .Range("E1").Value + amt
              .Range("F1").Value = .Range("F1").Value + pl
            End With
          End If
        End If
      End If
    Next
  Next
  
End Sub

【76993】Re:【VBA】不特定数データを検索したシー...
発言  Haruka  - 15/4/27(月) 9:23 -

引用なし
パスワード
   ▼β さん:

丁寧な御回答ありがとうございました!
社から質問していたので、御礼が遅くなってしまい失礼致しました。

これから実際のファイルに適用させてみます。
もしまた分からないところがあったらご質問させて頂ければと思います。

取り急ぎ、御礼をさせて頂きます。
本当にありがとうございました!

【76994】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/27(月) 9:43 -

引用なし
パスワード
   ▼Haruka さん:

はい。検証よろしく。

ところで月コード、内容はよくわからないのですが、仮に各地域シートで
1月はここ、2がつはここ、3月はここ といったことが決まっているなら
その月コードの場所を検索しなくても一発でセットできます。

【76995】Re:【VBA】不特定数データを検索したシー...
質問  Haruka  - 15/4/27(月) 15:04 -

引用なし
パスワード
   ▼β さん:

検証したら上手く行きました!初心者ですのでβさんのコードがとても勉強に
なりました。本当にありがとうございます!

1つ質問なのですが、このコードで元データの1つ目の空白セルまでは
処理しているのですが、次のセルの地域コードに移行しません。
元データの6行目までは行くのですが、7行目に移行しません。
元データの商品コード数は不特定数なのですが、この処理を繰り返すためには
どのようにしたらいいかご教示頂けると本当に助かります。

リクエストばかりしてしまい、本当にすみません!
ご助言頂けると本当に助かります。宜しくお願い致します。

【76996】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/27(月) 15:52 -

引用なし
パスワード
   ▼Haruka さん:

>1つ質問なのですが、このコードで元データの1つ目の空白セルまでは
>処理しているのですが、次のセルの地域コードに移行しません。

アップした Test でも Test2 でも、「もちろん」いくつ地域があろうと対応します。
それが、Haruka さんの要件ですから。

こちらで動かすとちゃんと反映していますよ。

そちらでうまくいかなかったのは Test のほうですか?
また、データに不整合があった場合、マクロ内でメッセージをだしていますが
そういうものは、なにか出ましたか?

Test も Test2 も ブロックの間は【空白】だと理解しています。
ただし、Test は、A列の【空白】セルをチェックしています。
で、ブロック間の「空白に見えているセル」に【スペース】が入っていたり、
あるいは、数式で "" といったものになっていれば、空白とはみなしません。
(目に見えない制御文字がはいっていても空白とはみなされません)

Test2は、ちょっと異なる把握で、逆に、【空白以外】が1かたまりのブロックだと認識しています。
ですから、間の【空白】が【スペース】あるいは【目に見えない制御文字】なら空白とはみなされず、次の地域があるという認識が
これまたできなくなります。

まず、ブロックの間の【空白】がどうなっているのか、教えてください。

【76997】Re:【VBA】不特定数データを検索したシー...
発言  β  - 15/4/28(火) 7:21 -

引用なし
パスワード
   ▼Haruka さん:

ご参考までに空白に見えるところが空白なのかどうかを判定するサンプルです。
新規ブックでお試しください。

Sub 空白確認()
  Dim c As Range
  
  Range("A1:A5").NumberFormatLocal = "G/標準"
  
  Range("A1").ClearContents          '本当の空白
  Range("A2").NumberFormatLocal = "@"     '文字列書式
  Range("A2").Value = ""           '長さ0の文字列
  Range("A3").Value = vbTab          '制御文字
  Range("A4").Value = " "          'スペース
  Range("A5").Formula = "=IF(1=1,"""","""")" '式による【空白】に見える値
  
  MsgBox "今から空白チェックをします"
  
  For Each c In Range("A1:A5")
    MsgBox c.Address(False, False) & ":" & IIf(IsEmpty(c), "空白です", "空白ではありません")
  Next
    
  MsgBox "次に補正を試みます"
  
  For Each c In Range("A1:A5")
    c.Value = Replace(Replace(c.Value, " ", ""), " ", "")
    c.Value = WorksheetFunction.Clean(c)
    c.NumberFormatLocal = "G/標準"
    c.Value = c.Value
  Next
  
  For Each c In Range("A1:A5")
    MsgBox c.Address(False, False) & ":" & IIf(IsEmpty(c), "空白です", "空白ではありません")
  Next
  
End Sub

【76998】Re:【VBA】不特定数データを検索したシー...
お礼  Haruka  - 15/4/28(火) 10:26 -

引用なし
パスワード
   βさん

ご提案、本当にありがとうございました。
もう一度やり直してみたら全部完璧に出来ました!

マクロ初心者で、今回βさんがお教え下さった事がとても
勉強になりました。社内に出来る人が皆無なので…
色々とご助言くださったこと、他のファイルにも適用して
とても便利になりそうです。(空白セルで困っていた処理があったので…)

また分からないことがあればご助言頂ければと思います。
心から御礼申し上げます。本当にありがとうございました!

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