以前何度もこの「VBA表作成」というタイトルで何度か質問させていただきました。
前回の締め切りのあと何度もデバック?やってみながら訂正してみたりしたのですが出来ませんでした。
☆詳細(仕様?)
・入力フォームブックで日付を入力すると出力ブックに入力した日付から1ヶ月の日付が表示されます。
・入力データブックがあり入力フォームで入力した日付から1ヶ月の日付で入力データにあるデータを貼り付けます。
・重複したデータは足して表示させます。
☆入力データブック
・B列に日付:日付の下に曜日が表示されています。
・M列に区分:1か2が書いてあります。
・T列に商品名:結合は関係ないとは思いますが、TからAPまで結合されています。
・AQ列に数量:AQからAUまで結合されています。
・BA列にコード:表示上記4つに比べ1行下に表記されていてBAからBDまで結合されています。
☆出力ブック
・BからHまで結合されており、B6に商品名が表示されます。(現時点では商品1つ分しかないので増えるたびに1行ずつセルが結合され挿入されます
・IからKまで結合されており、I6にコードが表示されます。(これも上記と同じ)
・6行目~→区分1の場合・8行目~→区分2の場合に表示します。
(1)出力ブック(以下book)の表は品名とコードを表示する部分が結合されているのですが、挿入され別の値が表示となったときに結合されておらず、コードも表示されませんでした。
(2)入らないはずの所に数値が入ってしまいます。
(3)入るはずの所に値が表示されません(8行目以降の欄)
・品名:B5からH5まで結合されています。
品名が表示されるのはB6からH6までで挿入されるときも結合されて表示されたいです。
・コード:I5からK5まで結合されています。
コードが表示されるのはI6からI6までで挿入されるときも結合されて表示されたいです。
Sub Get_nyuryoku(wDate As String, hNm As String, hCd As String, hKbn As String, s As Integer)
Dim wData As Worksheet
Dim i As Integer
Dim mR As Long
Set wData = Workbooks("入力データ.xls").Worksheets("Sheet1")
With wData
mR = .Cells(Rows.Count, "B").End(xlUp).Row
For i = 3 To mR
If .Cells(i, "B") = wDate Then '←ここで両方の日付を確認
hNm = .Cells(i, "T") ←商品名
hCd = .Cells(i, "BA") ←コード
hKbn = .Cells(i, "M") ←区分
s = .Cells(i, "AQ") ←数量
Exit For
End If
Next
End With
End Sub
お手数掛けますがよろしくおねがいします。
他に書かなきゃいけないことがありましたら言ってください。
No.1ベストアンサー
- 回答日時:
こんにちは。
以下の点について教えてください。
(1) 入力データブック上に日付が表示上と実際入力されている内容が同じなのか
→日付表ブックには、表示は「mm/dd」、実際入力情報としては「yyyy/mm/dd」です。
(2) 入力データブック上の日付は同じ日付が複数存在するのか。
→複数存在するなら、検索して加算処理が必要
後、セル追加処理時、セルの結合は行ってない「そこまでは知りませんでした」
入力データブックの日付入力形式が、多分文字列ではないでしょう
→文字列ではないと、Find では検索できないので、わざと、Forで回したのです。
Find を使えば簡単なんだけど・・・
取りあえず、セルの結合処理を追加しましたので、試してみてください。
どうしても、分からない場合は、現在のソース全てを提示くさい。
'商品情報の編集
Sub Edit_Shouhin(wSh2 As Worksheet)
Dim wC As Integer
Dim mC As Integer
Dim wDate As String
Dim hNm As String
Dim hCd As String
Dim hKbn As String
Dim hSu As Integer
Dim sTot1 As Integer
Dim sTot2 As Integer
Dim aSum As Integer
Dim Kbn1 As Integer
Dim Kbn2 As Integer
Dim wI As Integer
Dim fflg As Boolean
Dim wSu As Integer
'
sTot1 = 7: sTot2 = 9: aSum = 10
Kbn1 = 6: Kbn2 = 8
With wSh2
mC = .Cells(5, 12).End(xlToRight).Column
For wC = 12 To mC
wDate = wSh2.Cells(4, wC)
'商品情報取得
hNm = "": hCd = "": hKbn = "": hSu = 0 '★←追加
Call Get_HinData(wDate, hNm, hCd, hKbn, hSu)
Select Case hKbn
Case "1" '区分1
If .Cells(6, "B") = "" Then
.Cells(6, "B") = hNm '商品名
.Cells(6, "I") = hCd '商品コード
.Cells(6, wC) = hSu '数量
Else
fflg = False
For wI = 6 To Kbn1
If .Cells(wI, "B") = hNm Then
.Cells(wI, wC) = hSu '数量
fflg = True
Exit For
End If
Next
If fflg = False Then
'行の追加
.Rows(sTot1).Insert Shift:=xlDown
'セル結合
Range("B" & sTot1 & ":H" & sTot1).MergeCells = True '★←追加
Range("I" & sTot1 & ":K" & sTot1).MergeCells = True '★←追加
.Cells(sTot1, "B") = hNm '商品名
.Cells(sTot1, "I") = hCd '商品コード
.Cells(sTot1, wC) = hSu '数量
Kbn1 = Kbn1 + 1
Kbn2 = Kbn2 + 1
sTot1 = sTot1 + 1
sTot2 = sTot2 + 1
aSum = aSum + 1
End If
End If
Case "2" '区分2
If .Cells(Kbn1 + 2, "B") = "" Then
.Cells(Kbn1 + 2, "B") = hNm '商品名
.Cells(Kbn1 + 2, "I") = hCd '商品コード
.Cells(Kbn1 + 2, wC) = hSu '数量
Else
For wI = Kbn1 + 2 To Kbn2
If .Cells(wI, "B") = hNm Then
.Cells(wI, wC) = hSu '数量
fflg = True
Exit For
End If
Next
If fflg = False Then
'行の追加
.Rows(sTot2).Insert Shift:=xlDown
'セル結合
Range("B" & sTot2 & ":H" & sTot2).MergeCells = True '★←追加
Range("I" & sTot2 & ":K" & sTot2).MergeCells = True '★←追加
.Cells(sTot2, "B") = hNm '商品名
.Cells(sTot2, "I") = hCd '商品コード
.Cells(sTot2, wC) = hSu '数量
Kbn2 = Kbn2 + 1
sTot2 = sTot2 + 1
aSum = aSum + 1
End If
End If
End Select
Next
'
'小計設定(区分1)
For wC = 12 To mC
wSu = 0
For wI = 6 To Kbn1
wSu = wSu + .Cells(wI, wC)
Next
.Cells(sTot1, wC) = wSu
Next
'小計設定(区分2)
For wC = 12 To mC
wSu = 0
For wI = Kbn1 + 2 To Kbn2
wSu = wSu + .Cells(wI, wC)
Next
.Cells(sTot2, wC) = wSu
Next
'合計設定
For wC = 12 To mC
wSu = .Cells(sTot1, wC) + .Cells(sTot2, wC)
.Cells(aSum, wC) = wSu
Next
End With
End Sub
'商品情報取得
Sub Get_HinData(wDate As String, hNm As String, hCd As String, hKbn As String, hSu As Integer)
Dim wData As Worksheet
Dim wI As Integer
Dim c As Range
'
Set wData = Workbooks("入力データ.xls").Worksheets("Sheet2") '←実際のブック名とシート名に変更
With wData
mR = .Cells(Rows.Count, "B").End(xlUp).Row
'Set c = .Range("B3:B" & mR).Find(wDate)
'If Not c Is Nothing Then
' hNm = .Cells(c.Row, "T")
' hCd = .Cells(c.Row, "BA")
' hKbn = .Cells(c.Row, "M")
' hSu = .Cells(c.Row, "AQ")
'End If
For wI = 3 To mR
If .Cells(wI, "B") = wDate Then '←ここで両方の日付を確認してください
hNm = .Cells(wI, "T")
hCd = .Cells(wI, "BA")
hKbn = .Cells(wI, "M")
hSu = .Cells(wI, "AQ")
Exit For
End If
Next
End With
End Sub
この回答への補足
こんにちわ。
何度もすみません。
>(1) 入力データブック上に日付が表示上と実際入力されている内容が同じなのか
→日付表ブックには、表示は「mm/dd」、実際入力情報としては「yyyy/mm/dd」です
違います;;入力は「yyyy/mm/dd」で表は「mm/dd」で入力データは「mm/dd」になります
>(2) 入力データブック上の日付は同じ日付が複数存在するのか。
→複数存在するなら、検索して加算処理が必要
同じ日付が複数存在しています。
数値は一箇所だけになりましたが結合がされてませんでした;;
よろしくお願いします。
No.3
- 回答日時:
(1)
>区分1の方はできていたのですが変更したら区分2のコードと数値のみが表示されました。
不具合内容とか、出来ない部分の内容を具体的に言わないと分かりませんよ
→商品名が表示されないなら、検索の方から商品名が設定されて来るのか確認、
あるいは、設定したのに表示されないとか「この場合は設定セル位置の問題だと思うので
設定セルを正しく修正すれば良いでしょう」
(2)
>現在のソースは変更したところでいいですか?
全体のソースを提示しないと、何処が悪いのか分かりません。(ソースの一部では判断出来ない)
とにかく、自分で解決してみてくださいね。
全体のソース提示は、駄目な場合です。
すみません!!
できました!!
初期化するソースの場所と配列を使ってみたら同じ日付でも表示することができました!!
ありがとうございました
No.2
- 回答日時:
以下の★マーク部分を変更してください。
後、正しく動作しない部分がありましたら、自分で修正してみてくださいね。
どうしても、分からない時は、現在のソースそのまま提示してください。
商品情報取得
Sub Get_HinData(wDate As String, hNm As String, hCd As String, hKbn As String, hSu As Integer)
Dim wData As Worksheet
Dim wI As Integer
Dim c As Range
'
Set wData = Workbooks("入力データ.xls").Worksheets("Sheet2") '←実際のブック名とシート名に変更
With wData
mR = .Cells(Rows.Count, "B").End(xlUp).Row
For wI = 3 To mR
If Format(.Cells(wI, "B"),"mm/dd") = Format(wDate,"mm/dd") Then '←★変更
hNm = .Cells(wI, "T")
hCd = .Cells(wI, "BA")
hKbn = .Cells(wI, "M")
hSu = hSu + .Cells(wI, "AQ") '←★変更
'Exit For '←★変更(削除)
End If
Next
End With
End Sub
この回答への補足
ありがとうございます。
区分1の方はできていたのですが変更したら区分2のコードと数値のみが表示されました。
現在のソースは変更したところでいいですか?
'商品情報取得
Sub Get_nyuryoku(wDate As String, hNm As String, hCd As String, hKbn As String, s As Integer)
Dim wData As Worksheet
Dim i As Integer
Dim mR As Long
Set wData = Workbooks("入力データ.xls").Worksheets("Sheet1")
With wData
mR = .Cells(Rows.Count, "B").End(xlUp).Row
For i = 3 To mR
If Format(.Cells(i, "B"), "m/d") = Format(wDate, "m/d") Then '両方の日付を確認
hNm = .Cells(i, "T")
hCd = .Cells(i + 1, "BA")
hKbn = .Cells(i, "M")
s = s + .Cells(i, "AQ")
Exit For
End If
Next
End With
End Sub
これが今のソースです。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 2 2022/06/25 22:42
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) 別シートのデータを参照して値を入れたい。 まとめデータシートのC列D列の値を商品一覧シートのコードが 7 2022/08/17 13:20
- Visual Basic(VBA) ユーザーフォームに2つのコンボボックス銀行名「ConboBox1」支店名を「ConboBox2」とし 4 2022/08/03 17:34
- Visual Basic(VBA) VBA 税率を判定表する方法を教えて下さい。 10 2022/03/28 11:21
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルのVBAで日付を検索し転...
-
Eclipseの対応する括弧の強調表...
-
ユーザーフォームのラベルに日...
-
DataGridViewでyyyy/MM/dd
-
システム日付とは?
-
VB 日付範囲チェック
-
VBA 日付、未来の日付はエラー...
-
他のPCの日付・時刻の取得
-
コンボボックスに日付を表示する
-
日付をクリックすると別ページ...
-
「eclipseで作るカレンダー(ス...
-
3人のじゃんけんのプログラム
-
エクセルVBAで機械の稼働時間を...
-
VBAの質問になります 行の非表示
-
VBAで当月の1日を表示するには...
-
指定した日付が、その月の第何...
-
エクセルの試用期限の設定について
-
大文字Oと0の違い
-
ふと、気になる事が… 中年以降...
-
GAS ドキュメント
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBAの質問になります 行の非表示
-
ユーザーフォームのラベルに日...
-
Googleフォームで選択肢に応じ...
-
エクセルのVBAで日付を検索し転...
-
VisualBasic6.0のFormat関数で...
-
システム日付とは?
-
Eclipseの対応する括弧の強調表...
-
【VBA】土日をスキップして日付...
-
DataGridViewでyyyy/MM/dd
-
【Excel VBA】条件に合った行の...
-
VBAで当月の1日を表示するには...
-
VBA 日付、未来の日付はエラー...
-
JSPからYYYYMMDDで日付入力する
-
VB6.0 のformat関数について
-
指定した日付が、その月の第何...
-
VBで時間計算
-
VBAのオーバーフローについて質...
-
今日より前の書き方 マクロ
-
テキストボックスに今日の日付...
-
3人のじゃんけんのプログラム
おすすめ情報