Excel VBA質問箱 IV

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

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


267 / 3841 ページ ←次へ | 前へ→

【77097】Re:特定の文字間を抽出するマクロ
発言  γ  - 15/5/17(日) 22:06 -

引用なし
パスワード
   > xlsで検索して一致したセルに対して順番に処理する、
> というコードを入れていけばいいのでしょうか?
そう思います。
# 文字列操作の関数は個数が少なく、それでいて結果が分かりやすいので、
# 労力以上の見返り(充実感)がある気がします。
・ツリー全体表示

【77096】Re:特定の文字間を抽出するマクロ
お礼  moko  - 15/5/17(日) 21:41 -

引用なし
パスワード
   γ 様
ご教授ありがとうございます。

頂いたコードを参考にさせて頂きます。
全く思いつきませんでした。
.xlsで検索して一致したセルに対して順番に処理する、というコードを入れていけばいいのでしょうか?

>ちなみに、名古屋と沖縄の取扱が異なる理由は?
→申し訳ございません。
下記間違いでした。大変申し訳ございません。
純粋に_と.xlsの間の取り出し、なければそのままです。
担当者によってデータ入力ルールが異なっていたため現在悩んでいるところです。

名古屋
沖縄
東京
北海道
大阪
千葉
・ツリー全体表示

【77095】Re:特定の文字間を抽出するマクロ
発言  γ  - 15/5/17(日) 21:22 -

引用なし
パスワード
   部品です。参考にしてください。

Sub test()
  Dim s As String
  
  s = "2015051_0101番_東京.xls"
  s = Mid(s, InStrRev(s, "_") + 1)
  MsgBox Replace(s, ".xls", "")
End Sub
・ツリー全体表示

【77094】Re:特定の文字間を抽出するマクロ
発言  γ  - 15/5/17(日) 21:08 -

引用なし
パスワード
   InStrRev 関数を使って、
うしろから検索して最初に "_" が登場する位置を求めます。
あとは、Mid関数で取り出し、".xls"を""に置換。
と言った方針でどうでしょう。

ちなみに、名古屋と沖縄の取扱が異なる理由は?
・ツリー全体表示

【77093】特定の文字間を抽出するマクロ
質問  moko  - 15/5/17(日) 20:57 -

引用なし
パスワード
   VBA初心者です。
現在業務で必要なマクロを本等をみながら試行錯誤作っております。
マクロ作成工程の中で、一部どのように組んでいいかわからないものがありまして、ご教授頂けませんでしょうか?
どのように記載していいか検討もつかなかったので、自分で作成したものもなく、大変申し訳ないのですが、教えて頂けますと幸いです。

全体的には、データを操作するマクロなのですが、その中でマクロ記載ブック内のデータシートの1行目には項目が記載しており、2行目以降データがあり、最下行は都度変わります。
このようなデータです。

C列
支店名 ←1行目
名古屋
沖縄
2015051_0101番_東京.xls
2015年_0202_北海道.xls
大阪
2015051_0101_千葉.xls

上記の列を、下記のように置き換えたいのですが。

C列
支店名
名古屋
東京
北海道
大阪
千葉

「_」と「.xls」の間の文字のみに置き換えたいのですが、「_」は二つ入っておりますので、(三つの場合もあります)最後の「_」と「.xls」の間の取り出しということになりますので、どのようにマクロを作成していいか全くわかりません。
また、_や.xlsが入っていない行もありますので、その場合は置き換えは不要となります。
_と.xlsは必ず同時に入っている想定です。
「_」が一つならまだしも二つ、三つ入っている場合となるとどのようにしていいかわかりません。
マクロの中の一つの工程となりますので、マクロでの処理を希望です。

どなたかお分かりの方、お助け頂きたくお願い致します。
・ツリー全体表示

【77092】Re:検索して集計するマクロ
お礼  yumeyume  - 15/5/15(金) 21:18 -

引用なし
パスワード
   kanabun様

>
>Dim MyR
>と書いたら、
>Dim MyR As Variant
>の意味です。

そうだったのですね!
もっと宣言についても勉強しないといけませんね。

>Match は 単一列、または 単一行の検索に限定されますが、
>数値や 日付 の検索には絶対 Match がおすすめです。
>Findはどちらかというと 文字列の検索用ですね。日付の検索に Findは
>使えませんね。
>
>>またMatc検索は完全一致検索のみですよね?
>そんなことないですよ。
>
> Application.Match("*東*", RangeF, 0)
>
>のようなワイルドカード検索ができます。

なるほど。
ワイルドカードを使う場合は他の検索コードになるのかと思っていました。
本当に勉強することがたくさんあります。
でも、マクロは使えるようになると本当に仕事に役立ちますね。
今回頂いたコードもしっかり理解し、覚えておくようにします。
ありがとうございました。
・ツリー全体表示

【77091】Re:検索して集計するマクロ
発言  kanabun  - 15/5/15(金) 20:34 -

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

>下記変数の宣言ですが、おっしゃる通り、
>>Dim MyR As Long
>にしてしまいました・・。
>
>そのように変更しましたら正しく動きました。

Dim MyR
と書いたら、
Dim MyR As Variant
の意味です。

>また、今回Matchにて検索しましたが、今後も検索するマクロ作成機会が多そうです。
>Match以外もfind検索もありますが、どちらが使用しやすい?パターン等あるのでしょうか?他にも検索の構文がたくさんありそうですよね。

Match は 単一列、または 単一行の検索に限定されますが、
数値や 日付 の検索には絶対 Match がおすすめです。
Findはどちらかというと 文字列の検索用ですね。日付の検索に Findは
使えませんね。

>またMatc検索は完全一致検索のみですよね?
そんなことないですよ。

Application.Match("*東*", RangeF, 0)

のようなワイルドカード検索ができます。
・ツリー全体表示

【77090】Re:検索して集計するマクロ
お礼  yumeyume  - 15/5/15(金) 20:04 -

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

お返事ありがとうございました。

>
>変数MyR の宣言はどうなってますか?
>Dim MyR
>
>ですよ。
>
>Dim MyR As Long
>ではありませんよ!
>下のように宣言すると、エラー値を 整数変数に代入できなくて
>「実行時エラー13 型が一致しません」
>となります。

下記変数の宣言ですが、おっしゃる通り、
>Dim MyR As Long
にしてしまいました・・。


ご教授頂いたコードを手打ちで打ったので、
あれ?と思って追記してしまいました。
大変申し訳ございません。

そのように変更しましたら正しく動きました。
ありがとうございます。

変数の宣言は必ず As〜をつけるものと思い込んでいました。
目からウロコでびっくりでした。

また、マッチ検索の位置の戻りをそのまま使用するとは、
全く知らなかったので大変勉強になりました。

また、withでまとめたり、変数を宣言を必ずする等細かなところをきっちりする事が正しいマクロを作る秘訣ですね。
どんどんコード内に追加仕様を追記していったら変数の宣言等もめちゃくちゃになり分かりにくいマクロになっていました・・。
作り始めると、この処理もいれなくては、この分岐も必要だ・・等考えて追加していったところ非常に分かりづらい記載になり、結果エラー原因がよくわからなくなっていました。

また、今回Matchにて検索しましたが、今後も検索するマクロ作成機会が多そうです。
Match以外もfind検索もありますが、どちらが使用しやすい?パターン等あるのでしょうか?他にも検索の構文がたくさんありそうですよね。
またMatc検索は完全一致検索のみですよね?

こちらは今回のコードの件とはまた別になりますので、もしお答え頂いたら幸いと思っております。
初心者テキスト本には構文は記載ありますが、実践に即していなくて・・。
マクロの組み方も手探り状態で一部分づつ作って組み合わせて・・。構文が足りずまた足して〜という状態ですがkanabun様レベルですと全体像が見えてるのでしょうかね。

本当に今回は助かりました。
ありがとうございました。
・ツリー全体表示

【77089】Re:設定済のテーブル内への転記
発言  kanabun  - 15/5/15(金) 18:40 -

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

>
>1行目だったときは、テーブルの項目行しかないときで、
>=データがまだない状態と想定しています。
>なので、その場合の伝票番号は『1』に設定したいのです。

つまり、End(xlUp)で求めた最終行が1行目なら、項目行だけ書き込んである状態
ということで、データ書き込み行は自動で 2行目、No は 1 ということですか?

なら、以下でどうですか?

Sub 明細保存2()
 Dim wst1 As Worksheet   'コピー元
 Dim wst2 As Worksheet   '転記先
 Dim i As Long       'ループ用
 Dim LastCell As Range   'データ最終セル
 Dim newRow As Long    '貼付先行番号
 Dim No As Long      '伝票番号

 Set wst1 = ActiveSheet     '入力元が複数パターンあるので
 Set wst2 = ThisWorkbook.Worksheets("DB")

 Set LastCell = wst2.Range("A" & Rows.Count).End(xlUp)
 If LastCell.Row = 1 Then    '一行目のとき = 項目行だけのとき
   newRow = 2
   No = 1
 Else
   newRow = LastCell.Row + 1
   No = LastCell.Value + 1
 End If

 For i = 21 To 47
  If wst1.Range("G" & i) = "" Then
    Exit For
  Else
   With wst2.Range("A" & newRow)
    .Value = No            '伝票番号
    .Range("B1").Value = wst1.Range("H2").Value  '日付
    .Range("C1").Value = wst1.Range("A3").Value  '発注先
    .Range("D1").Value = wst1.Range("B9").Value  '件名
    .Range("E1").Value = wst1.Range("B11").Value  '納品先
    .Range("F1").Value = wst1.Range("I15").Value  '発注者
 
    .Range("G1").Value = wst1.Range("A" & i).Value  '品名
    .Range("H1").Value = wst1.Range("D" & i).Value  '仕様
    .Range("I1").Value = wst1.Range("G" & i).Value  '数量
    .Range("J1").Value = wst1.Range("F" & i).Value  '単位
    .Range("K1").Value = wst1.Range("H" & i).Value  '備考
 
    .Range("L1").Value = wst1.Range("B14").Value  '希望納期
    .Range("N1").Value = "FAX"  '注文方法
    .Range("O1").Value = wst1.Range("A18").Value  '伝票備考1
    .Range("P1").Value = wst1.Range("A19").Value  '伝票備考2
   End With
   newRow = newRow + 1 'つぎの行
   No = No + 1     '◆ この行追加
   End If
 Next i
End Sub
・ツリー全体表示

【77088】Re:設定済のテーブル内への転記
発言  doro  - 15/5/15(金) 18:00 -

引用なし
パスワード
   ▼kanabun さん:
こんにちは。大変素早い返信、ありがとうございます。助かります。

>↑3つ
>> wst2.Range("A" & Rows.Count).End(xlUp)
>というコードが出てきてます。

微妙に違うのはいろんなサイトさんでコピペさせて頂いているから
というお恥ずかしい話ですが…この辺もWithでまとめられるものでしょうか?
『なんだかなぁ…』とは思っていたんですが、
言われてみればいけるような気がしてきました。
ちょっと後日試してみます。


>1つめの
>> If wst2.Range("A" & Rows.Count).End(xlUp).Row = 1 Then '最初の伝票番号
>ですが、.End(xlUp) して 1行目だったとき、つまり[A1]セルだったとき、
>[A1]セルの値をチェックしなくていいんですか?
>
>Case-1. [A1]セルにまだ何も入っていないばあい→ 追加データは1行目に書き込みます
>
>Case-2. [A1]セルに 1 と入っているばあい →データは +1して2行目に書きこむ必要が
> あります。

1行目だったときは、テーブルの項目行しかないときで、
=データがまだない状態と想定しています。
なので、その場合の伝票番号は『1』に設定したいのです。
…記述漏れで申し訳ありませんが、テーブル側に関数等も設定されていて、
テーブルはないと困るので今回はテーブル自体がない場合は想定しませんでした。
・ツリー全体表示

【77087】Re:設定済のテーブル内への転記
発言  kanabun  - 15/5/15(金) 17:53 -

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

もし、上のようなことが関係しているのなら、
End(xlUp) で求めた最下行が [A1]のとき、
値のある/なし で、以下のように分岐してはいかがでしょう?

Sub 明細保存1()
 Dim wst1 As Worksheet   'コピー元
 Dim wst2 As Worksheet   '転記先
 Dim i As Long       'ループ用
 Dim LastCell As Range   'データ最終セル
 Dim newRow As Long    '貼付先行番号
 Dim No As Long      '伝票番号

 Set wst1 = ActiveSheet     '入力元が複数パターンあるので
 Set wst2 = ThisWorkbook.Worksheets("DB")

 Set LastCell = wst2.Range("A" & Rows.Count).End(xlUp)
 If LastCell.Row = 1 Then    '一行目のとき
   If IsEmpty(LastCell) Then  '未入力なら
     newRow = 1
     No = 1
   Else            'すでに書き込みあれば
     newRow = 2
     No = 2
   End If
 Else
   newRow = LastCell.Row + 1
   No = LastCell.Value + 1
 End If

 For i = 21 To 47
  If wst1.Range("G" & i) = "" Then
    Exit For
  Else
   With wst2.Range("A" & newRow)
    .Value = No            '伝票番号
    .Range("B1").Value = wst1.Range("H2").Value  '日付
    .Range("C1").Value = wst1.Range("A3").Value  '発注先
    .Range("D1").Value = wst1.Range("B9").Value  '件名
    .Range("E1").Value = wst1.Range("B11").Value  '納品先
    .Range("F1").Value = wst1.Range("I15").Value  '発注者
 
    .Range("G1").Value = wst1.Range("A" & i).Value  '品名
    .Range("H1").Value = wst1.Range("D" & i).Value  '仕様
    .Range("I1").Value = wst1.Range("G" & i).Value  '数量
    .Range("J1").Value = wst1.Range("F" & i).Value  '単位
    .Range("K1").Value = wst1.Range("H" & i).Value  '備考
 
    .Range("L1").Value = wst1.Range("B14").Value  '希望納期
    .Range("N1").Value = "FAX"  '注文方法
    .Range("O1").Value = wst1.Range("A18").Value  '伝票備考1
    .Range("P1").Value = wst1.Range("A19").Value  '伝票備考2
   End With
   newRow = newRow + 1 'つぎの行
  End If
 Next i
End Sub
・ツリー全体表示

【77086】Re:設定済のテーブル内への転記
発言  kanabun  - 15/5/15(金) 17:27 -

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

こんにちは〜
直接には関係ないかもしれないけれど、
ちょっと気になったこと。

> 
> If wst2.Range("A" & Rows.Count).End(xlUp).Row = 1 Then '最初の伝票番号
>  No = 1
> Else
>  No = wst2.Range("A" & Rows.Count).End(xlUp).Value + 1
> End If

>   myRow = wst2.Cells(Rows.Count, 1).End(xlUp).Row + 1
>   wst2.Range("A" & myRow).Value = No            '伝票番号

↑3つ

> wst2.Range("A" & Rows.Count).End(xlUp)

というコードが出てきてます。
(3つ目は wst2.Cells(Rows.Count, 1).End(xlUp) ですが)

1つめの
> If wst2.Range("A" & Rows.Count).End(xlUp).Row = 1 Then '最初の伝票番号
ですが、.End(xlUp) して 1行目だったとき、つまり[A1]セルだったとき、
[A1]セルの値をチェックしなくていいんですか?

Case-1. [A1]セルにまだ何も入っていないばあい→ 追加データは1行目に書き込みます

Case-2. [A1]セルに 1 と入っているばあい →データは +1して2行目に書きこむ必要が
 あります。
・ツリー全体表示

【77085】設定済のテーブル内への転記
質問  doro  - 15/5/15(金) 16:32 -

引用なし
パスワード
   お邪魔します。当方Excel2013使用です。
発注明細をデータベースっぽく一覧に転記していこうとしています。
勉強中ですので、質問点以外にもお気づきの改善点ありましたらご指摘ください。

入力元には伝票番号のような『ヘッダ』要素と
それに対して複数の『明細』があります。
先方に合わせたいくつかの書式があり、下記コードはそのうちの一部です。

フィルター機能の等を利用したいので、貼付先は『テーブル』機能を利用しています。
この場合、1行でも先にデータがあればそれ以降は問題ないのですが、
最初の明細(2行目に入ってほしい)データが
どうしてもテーブルの外になる3行目から転記されてしまいます。
転記先の行番号についての記述がおかしいのか?とも思いましたが
そうでもなさそうですし、かと言っていろいろ検索かけても
そんなところで躓いている人を見つけられず…

このままでも最初の一回だけ手作業でコピペすれば使えなくはないのですが、
将来的に利用するのは私だけではない予定なので、
できればなんとか改善したいと考えてます。
よろしければご教授ください。宜しくお願いします。


Sub 明細保存()
 Dim wst1 As Worksheet    'コピー元
 Dim wst2 As Worksheet    '転記先
 Dim i As Long     'ループ用
 Dim myRow As Long   '貼付先行番号
 Dim No As Long     '伝票番号

 Set wst1 = ActiveSheet     '入力元が複数パターンあるので
 Set wst2 = ThisWorkbook.Worksheets("DB")
 
 If wst2.Range("A" & Rows.Count).End(xlUp).Row = 1 Then '最初の伝票番号
  No = 1
 Else
  No = wst2.Range("A" & Rows.Count).End(xlUp).Value + 1
 End If

 For i = 21 To 47
  If wst1.Range("G" & i) = "" Then
   Exit For
  Else
   myRow = wst2.Cells(Rows.Count, 1).End(xlUp).Row + 1

   wst2.Range("A" & myRow).Value = No            '伝票番号
   wst2.Range("B" & myRow).Value = wst1.Range("H2").Value  '日付
   wst2.Range("C" & myRow).Value = wst1.Range("A3").Value  '発注先
   wst2.Range("D" & myRow).Value = wst1.Range("B9").Value  '件名
   wst2.Range("E" & myRow).Value = wst1.Range("B11").Value  '納品先
   wst2.Range("F" & myRow).Value = wst1.Range("I15").Value  '発注者

   wst2.Range("G" & myRow).Value = wst1.Range("A" & i).Value  '品名
   wst2.Range("H" & myRow).Value = wst1.Range("D" & i).Value  '仕様
   wst2.Range("I" & myRow).Value = wst1.Range("G" & i).Value  '数量
   wst2.Range("J" & myRow).Value = wst1.Range("F" & i).Value  '単位
   wst2.Range("K" & myRow).Value = wst1.Range("H" & i).Value  '備考

   wst2.Range("L" & myRow).Value = wst1.Range("B14").Value  '希望納期
   wst2.Range("N" & myRow).Value = "FAX"  '注文方法
   wst2.Range("O" & myRow).Value = wst1.Range("A18").Value  '伝票備考1
   wst2.Range("P" & myRow).Value = wst1.Range("A19").Value  '伝票備考2
  End If
 Next i
End Sub
・ツリー全体表示

【77084】Re:検索して集計するマクロ
発言  kanabun  - 15/5/15(金) 15:09 -

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

>最初の検索で一致しなかった場合にエラー13が出ます。
>実行時エラー13 型が一致しません です。
>
>MyRは0になっているようです。

>    MyR = Application.Match(.Cells(k, "C"), RangeF, 0)

と書いていて、「実行時エラー13 型が一致しません」となるのですか?
ちょっと考えられないですね?

>MyRは0になっているようです。

● Application.Match(.Cells(k, "C"), RangeF, 0)
の構文で、
一致するセルがなかった時には エラー値 (#N/A)が返ります。

◆ WorksheetFunction.Match を使うと、
一致するセルがなかった時は エラーでプログラムの実行がSTOP していまいます。

今回は Application.Match の方を使っているので、
MyR が 0になっていることはありえません。

変数MyR の宣言はどうなってますか?
Dim MyR

ですよ。

Dim MyR As Long
ではありませんよ!
下のように宣言すると、エラー値を 整数変数に代入できなくて
「実行時エラー13 型が一致しません」
となります。
・ツリー全体表示

【77083】Re:検索して集計するマクロ
質問  yumeyume  - 15/5/15(金) 14:20 -

引用なし
パスワード
   kanabun様

先程の質問の件ですが、そもそもの2つのシートの検索が一致しなかった場合のelseの処理を記載していなかった事が原因かと思い、Ifに対する偽の処理、else処理をend selectの後に記載してみました。

取り急ぎは動くかどうかの確認で、マクロブックの該当行のJ列に○をつけるような(上記のselect処理の×を○に変えたコード)を記載したのですが、同じエラーが出ます。

外出先なので、詳細なコードが記載できないのですが、この情報で何かお気づきの点がありますでしょうか?

今のところ検索データがなかった場合以外は正常に動いているようです。
・ツリー全体表示

【77082】Re:検索して集計するマクロ
質問  yumeyume  - 15/5/15(金) 13:53 -

引用なし
パスワード
   kanabun様

返信ありがとうございます。
マッチ検索の返り値の件等、大変勉強になりました。
コードもすっきりし、大変見やすくなりました。

外出先ですので、お礼等後ほどさせて頂きたく。
ステップインにて処理の確認をしておりまして、不明のため取り急ぎ質問をさせてください。

最初の検索で一致しなかった場合にエラー13が出ます。
実行時エラー13 型が一致しません です。

MyRは0になっているようです。
一致しない場合は×の処理を記載しているのになぜでしょうか?

お分かりでしたらご教授頂けますと幸いです。
・ツリー全体表示

【77081】Re:検索して集計するマクロ
発言  kanabun  - 15/5/15(金) 0:15 -

引用なし
パスワード
   追加で、
Matchしたときに帰ってくる数値ですのことですが...

> Set sh2 = Workbooks("集計表.xlsm").Worksheets(2)
> Set RangeF = sh2.Range("F6:F115")

>    ' 集計表ブックのF6からF115範囲に マッチするセルがあるか?
>    MyR = Application.Match(.Cells(k, "C"), RangeF, 0)

.Cells(k, "C") を 範囲RangeF からMatch検索していますが、
このとき MyR に 1 という数値が返ってきたとしますと、それは
RangeFという範囲の 1番目のセル で一致という意味であることはご存知ですよね?

RangeF という範囲の1番目のセルを RangeF.Item(1) と表現します。
RangeF は sh2 の.Range("F6:F115") の範囲のことですから、その1番目のセルは
具体的にはシート上の[F6]セルのことなのですが、いつもシート上の絶対番地に
なおさず、「検索範囲の何番目」というママの数値を使ったほうが 複雑にならずに
済みます。
ところで コードでは RangeF.Item(MyR) とあらわさず、

> RangeF.Item(MyR, 7)

という表記をしていますが、これは RangeF範囲の (1行目、7列目)のセル という
意味です。

RangeF.Item(1,1) が [F6]
RangeF.Item(1,2) が [G6]
RangeF.Item(1,3) が [H6]
RangeF.Item(1,4) が [I6]
  :
RangeF.Item(1,7) が [L6]

ということで、 RangeF.Item(MyR, 7) は RangeF列の MyR行目のセルの 右側7列目の
セル、ということになります。
下の
RangeF.Item(1,11) も 同じ考えで [P6] セルとなります。

なお、Itemは省略可能ですから
RangeF(1,11) と書くことも可能です。


あと、
   MyR = Application.Match(.Cells(k, "C").Value, RangeF, 0)
と検索値を Valueをつけるのは良くないです。
なぜなら Matchワークシート関数で検索値は セルの.Value値ではなく
セルの .Value2 値 だからです。たいていのばあい、 セルのValue2値 は セルの
Value値と同じですが、日付のときはValue2値は 42345 などのシリアル数値です。
Value値(2015/5/15) でMatch検索しても絶対にヒットしません。

   MyR = Application.Match(.Cells(k, "C").Value2, RangeF, 0)

↑このように、つけるなら Value2
通常は何もつけないで セルを書いておけばいいです。↓

   MyR = Application.Match(.Cells(k, "C"), RangeF, 0)
・ツリー全体表示

【77080】Re:検索して集計するマクロ
発言  kanabun  - 15/5/14(木) 23:42 -

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

>とりあえず、シート3用のマクロを記載して、シート4とシート5分もコピーしセルの値等を変えて、下記マクロを記載してみましたが、正しく動きません。
>正しく検索して集計できているもの、出来ないものもあり。

ということで、とりあえず、コードのうえのほうだけに限定して
>Sub データ集計()
>
>Set sh2 = Workbooks("集計表.xlsm").Worksheets(2)
>
>'A支店のデータを集計
>'マクロブックの3シート目のA列最終行を取得
>mxr1 = ThisWorkbook.Worksheets(3).Range("A" & Rows.Count).End(xlUp).Row
>For k = 2 To mxr1
>'マクロブックの3シート目のC2セルから最終行までを集計票ブックのF6からF115のセルに記載の値と一致させる
>MyR = Application.Match(ThisWorkbook.Worksheets(3).Cells(k, "C").Value, sh2.Range("F6:F115"), 0)
> '一致したら
> If IsNumeric(MyR) Then
> 'myRに5を足した値
> MyR2 = MyR + 5
> Count = ThisWorkbook.Worksheets(3).Cells(k, "I").Value
> 'マクロブックの3シート目のG列が「青森」であったら
> If ThisWorkbook.Worksheets(3).Cells(k, "G").Value = "青森" Then
> '集計表ブックのシート2のL列に初期入力値にマクロブックのシート3のIの値を足して入力
> sh2.Cells(MyR2, "L").Value = sh2.Cells(MyR2, "L").Value + Count
> 'マクロブックの3シート目のG列が「秋田」であったら
> ElseIf ThisWorkbook.Worksheets(3).Cells(k, "G").Value = "秋田" Then
> '集計表ブックのシート2のP列に初期入力値にマクロブックのシート3のIの値を足して入力
> sh2.Cells(MyR2, "P").Value = sh2.Cells(MyR2, "P").Value + Count
> 'マクロブックの3シート目のG列が「空白」であったら
> 'A列の値を1シート目に転記する
> ElseIf ThisWorkbook.Worksheets(3).Cells(k, "G").Value = " " Then
> Set pastsaki = ThisWorkbook.Worksheets(1).Range("A1").Offset(BK)
> pastsaki.Value = ThisWorkbook.Worksheets(3).Cells(k, "A").Value
> 
>'データがなければ×をつける
>Else
>ThisWorkbook.Worksheets(3).Cells(k, "j").Value = "X"
>
>End If
>End If
>Next

>End Sub

インデントを付ける

変数は宣言してから使う(宣言漏れを自動でチェックさせるために
このコードを書いているモジュールの先頭に
Option Explicit
の宣言文を入れておく)

ThisWorkbook.Worksheets(3) が何度もでてくるので、With句で くくる

If ○○ = "青森" Then
ElseIf ○○ = "秋田" Then
ElseIf ○○ = 空白 Then
Else
End If

という構文は

Select Case ○○
Case "青森"
Case "秋田"
Case 空白
Case Else
End Select

という構文になおして ○○を何度も使わないようにまとめる

などに注意して、表面的(字面だけ)直すと、こんな風です。

---------------------------------------------------標準モジュール
Option Explicit

Sub データ集計1()
 Dim sh2 As Worksheet, RangeF As Range, ValueL
 Dim mxr1 As Long
 Dim k As Long
 Dim MyR
 Dim Count As Long
 Dim BK As Long
 
 Set sh2 = Workbooks("集計表.xlsm").Worksheets(2)
 Set RangeF = sh2.Range("F6:F115")
 
 'A支店のデータを集計
 With ThisWorkbook.Worksheets(3) 'マクロブックの3シート目
  'A列最終行を取得
  mxr1 = .Range("A" & Rows.Count).End(xlUp).Row
  For k = 2 To mxr1 'C2セルから最終セルまで順に
      ' 集計表ブックのF6からF115範囲に マッチするセルがあるか?
    MyR = Application.Match(.Cells(k, "C"), RangeF, 0)
    
    If IsNumeric(MyR) Then '一致するセルがあったら
      Count = .Cells(k, "I").Value
      Select Case .Cells(k, "G").Value
       Case "青森" 'G列の値が「青森」であったら
         'sh2のL列に初期入力値に この行のIの値を足して入力
         RangeF.Item(MyR, 7).Value = RangeF.Item(MyR, 7) + Count
       
       Case "秋田" 'G列の値が「秋田」であったら
         'sh2のP列に初期入力値に この行のIの値を足して入力
         RangeF.Item(MyR, 11).Value = RangeF.Item(MyR, 11) + Count
        
        
       Case Empty 'G列の値が「空白」であったら----??
         'A列の値を1シート目に転記する
         ThisWorkbook.Worksheets(1).Range("A1").Offset(BK) _
           .Value = .Cells(k, "A").Value
      
       Case Else
         'データがなければ×をつける
         .Cells(k, "j").Value = "X"
      
      End Select
    End If
  Next
   
 End With

End Sub

---
以上のような構文で、ステップインで 処理を追っていってみてください。


---
>'G列の値が「空白」であったら----??
の部分は
> Case Empty
としてあります(ブランクセルだったら、と同じ)。
このときの処理
> Worksheets(1).Range("A1").Offset(BK)
↑この BK が何なのか、意味不明です。
・ツリー全体表示

【77079】検索して集計するマクロ
質問  yumeyume  - 15/5/14(木) 20:54 -

引用なし
パスワード
   マクロ初心者ですが、業務で必要なため勉強中です。
今回、必要なマクロを作成しておりまして、途中工程までは出来ているのですが、この先につまづき、ご教授頂けませんでしょうか?
過去の質問等を見てつなぎ合わせてみたのですが、上手くいかず・・。
動いても思うように動かないためお助けいただきたく、お願いします。

マクロブックシート3〜5に各支店のデータをまとめたものがあります。
まずはマクロブックシート3(A支店)の値と集計表ブックのシート2の各項目と一致するか検索し(例.りんご、バナナ等商品)、一致したらマクロシート3内もう一項目の文字を判別(例.青森、秋田等)し、その文字によりシート3シートに記載された数値(「1」個)を集計表ブックシート2の各欄へ足して集計するというものです。
具体的にはマクロブックのシート3のC列の値と、集計表のF6:F115範囲で項目の一致を検索、一致後さらにシート3のG列の値により、Iに記入の数値を集計表の指定欄へ足していきます。集計表は更新していきますので、空データではなく、初期値に+していきます。(初期値0の場合もあります)
また、マクロブックのデータのC列の値は重複する文字がありますが、各1件として検索となります。(りんご、りんご、バナナ等)
青森、秋田等の部分は空白の場合もあります。
集計シートのF6〜F115の間は空欄もあります。(間に合計するセル等入れているため)
検索が一致しなければ、隣に×等をつけて、後でソートして別シートにコピーしようと思っています。

同じようにシート4(B支店)、シート5も集計していきますが、集計先のセルはそれぞれ異なります。
とりあえず、シート3用のマクロを記載して、シート4とシート5分もコピーしセルの値等を変えて、下記マクロを記載してみましたが、正しく動きません。
正しく検索して集計できているもの、出来ないものもあり。
シート3はまだいいのですが、シート4やシート5についてはコピーして手直ししたのですが全然動きません。

何がいけないのか不明のため、ご教授頂けませんでしょうか。

もっと良い方法があれば、組みなおして頂いて全く問題ありません。
記載方法がわからず、マッチ検索ではなく、find検索がいい等、手掛かりがあると助かります。


Sub データ集計()

Set sh2 = Workbooks("集計表.xlsm").Worksheets(2)

'A支店のデータを集計
'マクロブックの3シート目のA列最終行を取得
mxr1 = ThisWorkbook.Worksheets(3).Range("A" & Rows.Count).End(xlUp).Row
For k = 2 To mxr1
'マクロブックの3シート目のC2セルから最終行までを集計票ブックのF6からF115のセルに記載の値と一致させる
MyR = Application.Match(ThisWorkbook.Worksheets(3).Cells(k, "C").Value, sh2.Range("F6:F115"), 0)
'一致したら
If IsNumeric(MyR) Then
'myRに5を足した値
MyR2 = MyR + 5
Count = ThisWorkbook.Worksheets(3).Cells(k, "I").Value
 'マクロブックの3シート目のG列が「青森」であったら
 If ThisWorkbook.Worksheets(3).Cells(k, "G").Value = "青森" Then
 '集計表ブックのシート2のL列に初期入力値にマクロブックのシート3のIの値を足して入力
 sh2.Cells(MyR2, "L").Value = sh2.Cells(MyR2, "L").Value + Count
 'マクロブックの3シート目のG列が「秋田」であったら
 ElseIf ThisWorkbook.Worksheets(3).Cells(k, "G").Value = "秋田" Then
 '集計表ブックのシート2のP列に初期入力値にマクロブックのシート3のIの値を足して入力
 sh2.Cells(MyR2, "P").Value = sh2.Cells(MyR2, "P").Value + Count
 'マクロブックの3シート目のG列が「空白」であったら
 'A列の値を1シート目に転記する
 ElseIf ThisWorkbook.Worksheets(3).Cells(k, "G").Value = " " Then
 Set pastsaki = ThisWorkbook.Worksheets(1).Range("A1").Offset(BK)
 pastsaki.Value = ThisWorkbook.Worksheets(3).Cells(k, "A").Value
 
'データがなければ×をつける
Else
ThisWorkbook.Worksheets(3).Cells(k, "j").Value = "X"

End If
End If
Next


'B支店
mxr2 = ThisWorkbook.Worksheets(3).Range("A" & Rows.Count).End(xlUp).Row
For L = 2 To mxr2
'マクロブックの3シート目のC2セルから最終行までを集計票ブックのF6からF115のセルに記載の値と一致させる
MyR3 = Application.Match(ThisWorkbook.Worksheets(4).Cells(L, "C").Value, sh2.Range("F6:F115"), 0)
'一致したら
If IsNumeric(MyR3) Then
'myRに5を足した値
MyR4 = MyR3 + 5
Count = ThisWorkbook.Worksheets(4).Cells(L, "I").Value
 'マクロブックの4シート目のG列が「青森」であったら
 If ThisWorkbook.Worksheets(4).Cells(L, "G").Value = "青森" Then
 '集計表ブックのシート2のM列に初期入力値にマクロブックのシート3のIの値を足して入力
 sh2.Cells(MyR4, "M").Value = sh2.Cells(MyR4, "M").Value + Count
 'マクロブックの3シート目のG列が「秋田」であったら
 'ElseIf 〜続く

End Sub
・ツリー全体表示

【77078】Re:コンボボックスとチェックボックスの...
発言  mohimohi  - 15/5/14(木) 5:44 -

引用なし
パスワード
   ▼β さん:
おはようございます。
>>Public Sub Init()のdicの変数が定義されてないみたいで、エラーになりました。

>dic という変数は使って居ませんが?
あれれ。スミマセン。
もう一度みてから改めてご連絡します!

>もし、お手伝いが必要なら、質問を投げかけていただければ、対応しますから。
掲示版という環境に慣れなくて。。。
そうですよね!大変失礼致しました。これからもここでご対応よろしくお願いします。
・ツリー全体表示

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