マクロのつくり方がわかりません。

質問

以下はEXCELです。　A1のabcを同ブロックの13-07-31の
下（A5)にコピーするマクロをつくりたいのですが。
A7はA9にしたい。

-------A--------B
1-----abc------123
2---13-07-01--(空白）-
3----(空白)----456
4---13-07-31--(空白）-
5----(空白）---789
6-------空白行-------
7-----abc------123
8---13-07-31--(空白）-
9---(空白）---789
10-------空白行-------
以下続きます。

回答No.6

nishi6 · ベストアンサー

補足とapril21さんの横レス(^o^)を参考にし、データとニラメッコして、下記マクロを作ってみました。
質問のデータ並びは、
(1)AとBが空白の行でページが分かれる
(2)同一ページでは取引先は１度のみ印刷し同一日付も印刷しない。
この条件でデータを眺めるとうまく理解できます。ただ、印刷イメージを画面出力したものなら１頁の固定行数に対する残り行は空白行で埋めると思うんですが・・・これが不明。そこで、
(3)質問のために余分な空白行を削除した。
としてみました。できたのが下記で、質問の形式の並びを、取引先、日付、残高に並べなおします。印刷の逆関数みたいなものですね。
(1)、(2)までならそのままで、もし(3)が当たっていれば、PageMax = 1　を１頁の印刷行数に変えてみて下さい。空白行を操作しなくてもデータをきれいに並べ直すと思います。
かなり独断で想定（想像）しています。参考程度にして下さい。

標準モジュールに貼り付け、Matome2を実行。

Public rg As Range '基準セル(A1)
Public torihikisaki As String '取引先
Public hizuke As String '日付(文字列として読み込み)
Public zandaka As Long '残高
Public rw As Long '行カウンタ(読み込み用)
Public wrRow As Long '行カウンタ(書き出し用)
Public KuuhakuGyo As Integer '空白行カウンタ
Public Const PageMax = 1 '1ページ行数　これを印刷行数にしたら！？

Public Sub Matome2()
　Set rg = Range("A1") '基準位置
　wrRow = 0: rw = 0: KuuhakuGyo = 0: Yomikomi rw
　With rg
　　While KuuhakuGyo < PageMax
　　　If zandaka <> 0 Then
　　　　Kakikomi 'データを書き込む
　　　　rw = rw + 2
　　　　While Not (.Offset(rw, 0) = "" And .Offset(rw, 1) = "")
　　　　　If .Offset(rw, 0) <> "" Then hizuke = .Offset(rw, 0)
　　　　　If .Offset(rw, 1) <> "" Then zandaka = .Offset(rw, 1): Kakikomi
　　　　　rw = rw + 1
　　　　Wend
　　　End If

　　　rw = rw + 1: Yomikomi rw '次のブロック
　　Wend
　End With
End Sub

'データを読み込む(Sub)
Public Sub Yomikomi(rowNo As Long)
　With rg
　　torihikisaki = .Offset(rowNo, 0)
　　hizuke = .Offset(rowNo + 1, 0)
　　zandaka = .Offset(rowNo, 1)
　　If torihikisaki = "" Then KuuhakuGyo = KuuhakuGyo + 1
　End With
End Sub

'データを書き出す(Sub)
Public Sub Kakikomi()
　With rg
　　.Offset(wrRow, 3) = torihikisaki
　　.Offset(wrRow, 4) = hizuke
　　.Offset(wrRow, 5) = zandaka
　End With
　wrRow = wrRow + 1: KuuhakuGyo = 0
End Sub

お礼

ありがとうございます。
元データを簡略化して説明したので、
マクロに若干の修正が必要なようですが、
勉強いたします。
ありがとうございました。

回答No.5

april21

■訂正
E2に　=IF(TYPE(MID(A2,SEARCH("??-??-??",A2,1),LEN(A2)))=16,E1,A2)
だとABCの最初の日付が違ってしまいます。
（同じ日付だったので見た目気がつきませんでした^_^;）

E2に　=IF(TYPE(SEARCH("??-??-??",A2,1))=16,IF(AND(A2<>"",A3<>""),A3,E1),A2)

こんな感じで都合の悪い点は条件を追加してあげれば良いと思いますので
適当に変更してください。m(__)m

お礼

ありがとうございます。
勉強して理解します。

回答No.4

april21

>＞外部データから取り込む際に振り分けてしまってはどうでしょう
>何か本をご紹介賜れば幸甚です。
何の本でしょう？ＶＢＡのでしょうか？でしたら、VBAにヘルプがあるので
本は持っていないのですみませんがお力にはなれません。
本屋さんに行って必要なことが載ってるかどうか確かめて購入された方が
良いのでは？

>ホストのデータを帳票として画面に出して、その画面を
>ベースにデータとして取り込んだものです。
これだけではちょっと分からないので例題を関数で振り分けてみますね。

例題を一行ずらして（A2、B2が一行目）にして
2コ目のabcをABC（分かりやすいように）に変更。

D2に　=IF(AND(A2<>"",A3<>""),A2,D1)
E1に　=A3
E2に　=IF(TYPE(MID(A2,SEARCH("??-??-??",A2,1),LEN(A2)))=16,E1,A2)
F2に　=IF(B2="","",B2)

で、D2からF2まで選択してD11までフィルドラッグ
選択して「データ」-「オートフィルタ」で残高の▼をクリックして
「空白以外のセル」をポイント。
下記のようになってるはずなのでコピーして適当な所に貼付け。

abc 13-07-01 123
abc 13-07-01 456
abc 13-07-31 789
ABC 13-07-31 123
ABC 13-07-31 789

関数ですからどういうことをしてるか分かりますよね？
分からない関数はヘルプで調べてみてください。
意味がわかればご自分で変更して使えると思います。

回答No.3

april21

nishi6さん こんばんわ^^

ちょっと横レス失礼します。m(__)m
＞また、データの持ち方が一行になく行列に持っていますので苦労しています。
データベースのデータをEXCELで取り込んで苦労されてるのでは？

推測があってるなら見た感じでは文字列、数値、日付のデータのように思われる
ので外部データから取り込む際に振り分けてしまってはどうでしょう？
その方が簡単だと思いますが・・・。

では、(^^)/~~~

お礼

その通りです、Excelで取り込んで苦労しています。
dataが一行に並んでいて
例）取引先　　日付　　　残高
　　ＱＱＱ　　YYMMDD 111111
であればexcelでもアクセスでも何とか使えるのです
が、縦に並ぶと手も足もでません。

＞外部データから取り込む際に振り分けてしまってはどうでしょう
何か本をご紹介賜れば幸甚です。

回答No.2

nishi6

＞設定では先頭の文字のコピーにしましたが、その一行下の場合はどうでしょうか？

下記のように若干変更すればできます。13-07-01を貼り付けるんですよね。
Public Sub AtaiHarituke2()
Dim rg As Range 'セル
Dim rw As Long '行カウンタ
Dim Atai As String '先頭の値
Dim Atai2 As String '貼り付ける値

Set rg = Range("A1") '基準位置

With rg
Atai = .Offset(rw, 0)
While Atai <> "" 'なくなるまで続ける
rw = rw + 1
Atai2 = .Offset(rw, 0)
While Not (.Offset(rw + 1, 0) = "" And .Offset(rw + 2, 0) = "")
rw = rw + 2 'ブロックの最終行でなければ次へ
Wend
.Offset(rw + 1, 0) = Atai2 '値を貼り付け

rw = rw + 3 '次のブロック
Atai = .Offset(rw, 0)
Wend
End With
End Sub

＞また、データの持ち方が一行になく行列に持っていますので苦労しています。

チョッと意味を計りかねますが、一連のプロックが横に連なっている？意味ですか。この質問のデータの並びはそれを加工したものですか？
考え方によっては、データが文字列として整然と並んでいたほうが（あるパターンで）処理しやすいかもしれません。どのような形式でもデータの並びに規則性があればプログラム処理する上では問題ないと思います。

補足

ありがとうございます。お中元をお送りしたい気分です。
ホストのデータを帳票として画面に出して、その画面を
ベースにデータとして取り込んだものです。
＜どのような形式でもデータの並びに規則性があればプログラム処理する上では問＜題ないと思います。
そうなんでしょうね。
でも私レベルには大変です。

回答No.1

nishi6

質問の意味を理解していればいいのですが・・・・
各ブロックの先頭の文字は２つを見る限り「abc」ですが、「abc」と一致したら貼り付ける意味でしょうか？
下記マクロは「abc」に限らず、ブロックの先頭文字を最終行に貼り付けます。
意味が違っていたら補足して下さい。

標準モジュールを追加して貼り付けます。
Public Sub AtaiHarituke()
Dim rg As Range 'セル
Dim rw As Long '行カウンタ
Dim Atai As String '貼り付ける値

Set rg = Range("A1") '基準位置

With rg
Atai = .Offset(rw, 0)
While Atai <> "" 'なくなるまで続ける
rw = rw + 1
While Not (.Offset(rw + 1, 0) = "" And .Offset(rw + 2, 0) = "")
rw = rw + 2 'ブロックの最終行でなければ次へ
Wend
.Offset(rw + 1, 0) = Atai '値を貼り付け

rw = rw + 3 '次のブロック
Atai = .Offset(rw, 0)
Wend
End With
End Sub

お礼

いつも、ありがとうございます。
設定では先頭の文字のコピーにしましたが、
その一行下の場合はどうでしょうか？

また、データの持ち方が一行になく行列に
持っていますので苦労しています。
また質問したときはよろしくお願い致します。