Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3467 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【62024】行の挿入について（続き） mori 09/6/17(水) 13:17

【62031】Re:行の挿入について（続き） kanabun 09/6/17(水) 14:18

【62033】Re:行の挿入について（続き） mori 09/6/17(水) 19:39

【62034】Re:行の挿入について（続き） kanabun 09/6/17(水) 19:51

【62035】Re:行の挿入について（続き） kanabun 09/6/17(水) 20:22

【62049】Re:行の挿入について（続き） mori 09/6/18(木) 21:19

【62037】Re:行の挿入について（続き） kanabun 09/6/17(水) 21:52

【62036】Re:行の挿入について（続き） かみちゃん 09/6/17(水) 20:58

【62050】Re:行の挿入について（続き） mori 09/6/18(木) 21:25


	【62024】行の挿入について（続き）

mori - 09/6/17(水) 13:17 -


	引用なし

	パスワード

＞kanabunさん

何度も何度もありがとうございます。
取り急ぎ、概要を提示します。

元データはCSVファイルです。
CSVファイルを読み込んで、bookの一番最後に「TMP1」としてシートを作ってあります。
このシートはCSVデータそのままです。

　　摘要　　　数量
(1) 文房具類　　　　　　　　　
　　A4画用紙　200　　枚　　200　　　　4000
　　えんぴつ　200　　本　　100　　　　2000
　　消しゴム　200　　個　　 50　　　　1000
　　荷造費　　　1　　式　　　　　　　 2000
　　諸経費　　　1　　式　　　　　　　 1000
　　合計　　　　　　　　　　　　　　 10000

このCSVデータを下記のようにします。
（書式は既にあるシートです）

行番号　摘要　　　数量　　単位　　単価　　金額
(1) 　　文房具類
　　　　A4画用紙　200　　　枚　　 200　　 4000
　　　　えんぴつ　200　　　本　　 100　　 2000
　　　　消しゴム　200　　　個　　　50　　 1000

　　　　荷造費　　　1　　　式　　　　　　 2000

　　　　諸経費　　　1　　　式　　　　　　 1000
　　　　合計　　　　　　　　　　　　　　 10000
　　　　（この下に1行空白行）

概要としては、行番号の（）は'を付けて文字列扱いにする。
単位欄に「式」・単価欄がブランクであれば、上に1行挿入する。
合計欄の下に1行挿入する。
その他の文字などはそのまま入力する。
です。

よろしくお願い致します。


	【62031】Re:行の挿入について（続き）

kanabun - 09/6/17(水) 14:18 -


	引用なし

	パスワード

▼mori さん：

>概要としては、行番号の（）は'を付けて文字列扱いにする。
>単位欄に「式」・単価欄がブランクであれば、上に1行挿入する。
>合計欄の下に1行挿入する。
>その他の文字などはそのまま入力する。
>です。

シートのレイアウトが出てきたのでずいぶん分かりやすくなりましたね(^^

それなら、こうしたらどうですか？
Else のなかに
もうひとつ If文をおいて、そこに
>単位欄に「式」・単価欄がブランクであれば、上に1行挿入する。
特別処理を挿入しておく。

Sub CreateMitsumori▲5()

　Dim i　　　　　　　　　 As Long
　Dim j　　　　　　　　　 As Long
　Dim lngMaxRow　　　　　 As Long
　Dim newLine　　　　　　 As Long
　Dim str行番号 As String
　Dim str適用 As String
　Dim str数量 As String
　Dim str単位 As String
　Dim str単価 As String
　Dim str金額 As String
　Dim Trim適用 As String '適用項目トリミング後

　With Worksheets(3)
　　'一時シートから行数を取得
　　lngMaxRow = Worksheets("TMP1").Cells(Rows.Count, 1).End(xlUp).Row
　　j = 1
　　For i = 31 To lngMaxRow
　　　If j = 1 Then
　　　ElseIf j Mod 29 = 1 Then
　　　　'A列～U列まで 29行をCopy
　　　　.Range("A4").Resize(29, 21).Copy .Cells(j + 3)
　　　　With .Cells(j + 3).Resize(29, 21)
　　　　　　.RowHeight = 27
　　　　　　Worksheets(3).PageSetup.PrintArea = .Cells
　　　　End With
　　　End If
　　　j = j + 1
　　Next

　　newLine = 4 '最初の貼り付け先行番号
　　For i = 31 To lngMaxRow
　　　
　　　str行番号 = Worksheets("TMP1").Cells(i, 1).Value
　　　str適用 = Worksheets("TMP1").Cells(i, 2).Value
　　　str数量 = Worksheets("TMP1").Cells(i, 3).Value
　　　str単位 = Worksheets("TMP1").Cells(i, 4).Value
　　　str単価 = Worksheets("TMP1").Cells(i, 5).Value
　　　str金額 = Worksheets("TMP1").Cells(i, 6).Value

　　　'転記開始
　　　'行番号欄に記載のあったとき
　　　If Len(str行番号) > 0 Then
　　　　　'マイナス行番号をカッコ付き行番号にします
　　　　　If str行番号 Like "-*" Then
　　　　　　str行番号 = "'(" & Mid(str行番号, 2) & ")"
　　　　　End If
　　　　　.Cells(newLine, 1).Value = str行番号
　　　End If
　　　
　　　'摘要欄の文字列チェック
　　　Trim適用 = Application.Trim(str適用)
　　　If InStr(Trim適用, "値引") Then '値引があれば
　　　　Trim適用 = "値引"　　　　　　 '値引を抜き出します
　　　End If
　　　
　　　If Trim適用 = "合計" Then
　　　　.Cells(newLine, 2).Value = str適用 '合計
　　　　.Cells(newLine, 6).Value = str金額
　　　　newLine = newLine + 1　　　　　 '◆下に空行挿入
　　　
　　　ElseIf Trim適用 = "値引" Then
　　　　newLine = newLine + 1　　　　　 '◆上に空行挿入
　　　　.Cells(newLine, 2).Value = str適用
　　　　.Cells(newLine, 6).Value = str金額
　　　
　　　Else
　　　　'---------------------------------------------- 挿入
　　　　'単位欄が「式」で単価欄に記載がないときは
　　　　If str単位 = "式" And str単価 = "" Then
　　　　　　newLine = newLine + 1　　　 '◆上に空行挿入
　　　　End If
　　　　'---------------------------------------------------
　　　　.Cells(newLine, 2).Value = str適用
　　　　.Cells(newLine, 3).Value = str数量
　　　　.Cells(newLine, 4).Value = str単位
　　　　.Cells(newLine, 5).Value = str単価
　　　　.Cells(newLine, 6).Value = str金額
　　　End If
　　　
　　　newLine = newLine + 1　　　　　　 '◆次の転記行

　　Next

　End With

End Sub

あいかわらず、検証してませんので、不具合があれば
ご指摘ください。


	【62033】Re:行の挿入について（続き）

mori - 09/6/17(水) 19:39 -


	引用なし

	パスワード

kanabun さん

ご回答をありがとうございます。
早速、やってみました。

（前略）
>　With Worksheets(3)
>　　'一時シートから行数を取得
>　　lngMaxRow = Worksheets("TMP1").Cells(Rows.Count, 1).End(xlUp).Row
>　　j = 1
>　　For i = 31 To lngMaxRow
>　　　If j = 1 Then
>　　　ElseIf j Mod 29 = 1 Then
>　　　　'A列～U列まで 29行をCopy
>　　　　.Range("A4").Resize(29, 21).Copy .Cells(j + 3)　←この部分でエラーが出ます
>　　　　With .Cells(j + 3).Resize(29, 21)
>　　　　　　.RowHeight = 27
>　　　　　　Worksheets(3).PageSetup.PrintArea = .Cells
>　　　　End With
>　　　End If
>　　　j = j + 1
>　　Next

.Range("A4").Resize(29, 21).Copy.Cells(j + 3)
A4から29行・21列コピーする
pasteがないからか？と思ったのですが、うまくいきませんでした・・・


	【62034】Re:行の挿入について（続き）

kanabun - 09/6/17(水) 19:51 -


	引用なし

	パスワード

▼mori さん：

>（前略）
>>　With Worksheets(3)
>>　　'一時シートから行数を取得
>>　　lngMaxRow = Worksheets("TMP1").Cells(Rows.Count, 1).End(xlUp).Row
>>　　j = 1
>>　　For i = 31 To lngMaxRow
>>　　　If j = 1 Then
>>　　　ElseIf j Mod 29 = 1 Then
>>　　　　'A列～U列まで 29行をCopy
>>　　　　.Range("A4").Resize(29, 21).Copy .Cells(j + 3)　←この部分でエラーが出ます
>>　　　　With .Cells(j + 3).Resize(29, 21)
>>　　　　　　.RowHeight = 27
>>　　　　　　Worksheets(3).PageSetup.PrintArea = .Cells
>>　　　　End With
>>　　　End If
>>　　　j = j + 1
>>　　Next
>
>.Range("A4").Resize(29, 21).Copy.Cells(j + 3)
>A4から29行・21列コピーする
>pasteがないからか？と思ったのですが、うまくいきませんでした・・・

ごめんなさい。
その部分はノーチェックでした。
(ちょっと、この部分、何をやってるのか分からなかったです。)

オリジナルの

>　With Worksheets(3)
>　　'一時シートから行数を取得
>　　lngMaxRow = Worksheets("TMP1").Range("A1").SpecialCells(xlLastCell).Row

>　　j = 1
>　　For i = 31 To lngMaxRow
>　　　If j = 1 Then
>　　　ElseIf j Mod 29 = 1 Then
>　　　　.Range("A4:U32").Copy
>　　　　lngRowY = j + 3
>　　　　lngRowX = j + 31
>　　　　strRangeValue = "A" & lngRowY & ":" & "U" & lngRowX
>　　　　.Range(strRangeValue).PasteSpecial xlPasteAll
>　　　　.Range(strRangeValue).RowHeight = 27
>　　　　.PageSetup.PrintArea = .Range(strRangeValue)
>　　　End If
>　　　j = j + 1
>　　Next

に差し替えてお試しください。
（変数の宣言 strRangeValue や lngRowY lngRowX も必要です）


	【62035】Re:行の挿入について（続き）

kanabun - 09/6/17(水) 20:22 -


	引用なし

	パスワード

逆にこちらから質問なんですけど、
オリジナルのコードにあるこの部分は
何をしている部分なんでしょうか？

想像するに転記先シートWorksheets(3) の
.Range("A4:U32") に印刷用書式の設定された表のひな型
があって、「TMP1」のデータ行数が29行以上あるときは
超過分に必要な行数（29の倍数）だけ、このひな型29行を
下方にコピーしているようですが？

> With Worksheets(3)
> 　　'一時シートから行数を取得
> 　　lngMaxRow = Worksheets("TMP1").Range("A1").SpecialCells(xlLastCell).Row
> 　　blnFlag = False
> 　　j = 1
> 　　For i = 31 To lngMaxRow　　
> 　　　If j = 1 Then
> 　　　ElseIf j Mod 29 = 1 Then
> 　　　　.Range("A4:U32").Copy
> 　　　　lngRowY = j + 3
> 　　　　lngRowX = j + 31
> 　　　　strRangeValue = "A" & lngRowY & ":" & "U" & lngRowX
> 　　　　.Range(strRangeValue).PasteSpecial xlPasteAll
> 　　　　.Range(strRangeValue).RowHeight = 27
> 　　　　.PageSetup.PrintArea = .Range(strRangeValue)
> 　　　End If
> 　　　j = j + 1
> 　　Next
> 　　

そうすると、
> 行番号　摘要　　　数量　　単位　　単価　　金額
という見出し行は何行目にあるのですか？
4行目ですか？
3行目ですか？

また、項目数は 6項目なので
> .Range("A4:U32")
U列までコピーする必要はないような気がするのですが、これは
なぜでしょう？

よろしければ、教えてください。


	【62036】Re:行の挿入について（続き）

かみちゃん - 09/6/17(水) 20:58 -


	引用なし

	パスワード

こんにちは。かみちゃん　です。横から失礼します。前回のスレッドでYukiさんのアドバイスに基づき解決されているのではないでしょうか？一方で、kanabunさんのアドバイスでも解決を勧められているようですが、何がまだ解決できないのでしょうか？ >取り急ぎ、概要を提示します。概要というものは、最初の質問で、・シートレイアウト・現在のコード・何に困っているのか？　エラーが出るなら、エラーメッセージとどのコードでエラーが出ているのか・期待している結果を示すべきだと思います。つまり、概要を出すのが今ごろですか？という感じなのです。 moriさんのシートやデータは、掲示板を見ている者には、見えないので、今後は、そのあたりのことを十分配慮していただきたいと思います。さて、小言はこのあたりにしておいて、 CSVファイルですが、 "摘要","数量" "(1)","文房具類" ,"A4画用紙",200,"枚",200,4000 ,"えんぴつ",200,"本",100,2000 ,"消しゴム",200,"個",50,1000 ,"荷造費",1,"式",,2000 ,"諸経費",1,"式",,1000 ,"合計",,,,10000 というものなのですか？それを以下のようにしたいということなのでしょうか？　　 A　　　　 B　　　 C　　　 D　　　 E　　　 F 1 行番号　摘要　　　数量　　単位　　単価　　金額 2 (1) 　　文房具類 3 　　　　A4画用紙　200　　　枚　　 200　　 4000 4 　　　　えんぴつ　200　　　本　　 100　　 2000 5 　　　　消しゴム　200　　　個　　　50　　 1000 6 7 　　　　荷造費　　　1　　　式　　　　　　 2000 8 9 　　　　諸経費　　　1　　　式　　　　　　 1000 10 　　　　合計　　　　　　　　　　　　　　 10000 11　　　　（この下に1行空白行）行番号の質問なわけですから、何行目にデータがあるのかくらいはきちんと説明していただきたいと思います。ちなみに、投稿欄の右下にある「等幅」というところにチェックょすると、等幅フォントになり、シートレイアウトなどが綺麗に見えると思います。


	【62037】Re:行の挿入について（続き）

kanabun - 09/6/17(水) 21:52 -


	引用なし

	パスワード

こんばんは。

あと、ま、これは蛇足ですけど、
コピー元のデータを配列に入れておいて、
もうひとつの配列に条件付きで行処理をして転記して
最後にこの配列をまとめて転記先の範囲に値だけ書き込む
という手もありまして。。。

配列内でデータを再配置するのは高速化の常用手段ですので
参考までにサンプルをアップしておきます。

新規「標準モジュール」を追加してそこに
Option Explicit 行からコピーしてお試しください。
（注）
　・CSVデータは「TMP1」シートの31行目からあるものと仮定。
　・転記先シートは Worksheets(3) としています。
　・このシートの3行目に項目見出しがあり、
　　　4行目以降にデータを貼り付けるものと仮定しています。
　このあたりは適宜修正してください。

'-------------------------------------- 新規Module
Option Explicit

Enum 列番号
　行番号 = 1
　適用 = 2
　数量 = 3
　単位 = 4
　単価 = 5
　金額 = 6
End Enum

Sub 見積り作成6()
　Dim WS As Worksheet
　Dim i　　As Long
　Dim j　　As Long
　Dim newLine　As Long
　Dim PostAddLine As Long
　Dim v 'もとのデータ
　Dim u '転記用データ

　With Worksheets("TMP1")　'一時シートのデータを配列に入れる
　　v = .Range("A31", .Cells(Rows.Count, 2).End(xlUp)) _
　　　　.Resize(, 6).Value
　End With
　
　'転記先シートの書式Copy　　'この部分吟味されてません
　Set WS = Worksheets(3)
　If UBound(v) > 29 Then
　　　With WS.Range("A4")
　　　　　.Resize(29, 6).Copy .Offset(29)
　　　　　.Offset(29).Resize(29, 6).RowHeight = 27
　　　End With
　End If
　
　ReDim u(1 To 29, 1 To 金額)
　newLine = 1
　For i = 1 To UBound(v)
　　　PostAddLine = 0
　　　'行番号欄に記載のあったとき
　　　str行番号 = v(i, 行番号)
　　　If Len(str行番号) > 0 Then
　　　　　'マイナス行番号をカッコ付き行番号にします
　　　　　If str行番号 Like "-*" Then
　　　　　　v(i, 行番号) = "'(" & Mid(str行番号, 2) & ")"
　　　　　End If
　　　End If
　　　
　　　'転記行条件チェック
　　　If v(i, 適用) Like "*合*計*" Then
　　　　PostAddLine = 1　　　　　　　　 '◆下に空行挿入
　　　
　　　ElseIf v(i, 適用) Like "*値*引*" Then '「値引」の文字あり
　　　　newLine = newLine + 1　　　　　 '◆上に空行挿入
　　　
　　　ElseIf v(i, 単位) Like "式" And IsEmpty(v(i, 単価)) Then
　　　　'単位欄が「式」で単価欄に記載がないときは
　　　　　　newLine = newLine + 1　　　 '◆上に空行挿入
　　　End If
　　　'指定の行に値転記
　　　For j = 1 To 金額
　　　　u(newLine, j) = v(i, j)
　　　Next
　　　newLine = newLine + 1 + PostAddLine　 '◆次の転記行
　Next
　　
　WS.Range("A4").Resize(newLine - 1, 6).Value = u

End Sub


	【62049】Re:行の挿入について（続き）

mori - 09/6/18(木) 21:19 -


	引用なし

	パスワード

kanabun さん

レスが遅くなってしまって、申し訳ありません。
何度も何度も本当にありがとうございます。

>想像するに転記先シートWorksheets(3) の
>.Range("A4:U32") に印刷用書式の設定された表のひな型
>があって、「TMP1」のデータ行数が29行以上あるときは
>超過分に必要な行数（29の倍数）だけ、このひな型29行を
>下方にコピーしているようですが？
ご想像の通りです。
Worksheets(3)に印刷用の書式がある雛形が1ページ分のみ
ある状態です。

>そうすると、
>> 行番号　摘要　　　数量　　単位　　単価　　金額
>という見出し行は何行目にあるのですか？
>4行目ですか？
>3行目ですか？
見出し行は3行目・4行目にあります。
1行目・2行目には、この印刷書式に必要なものが書いてあります。
（固定値です

>また、項目数は 6項目なので
>> .Range("A4:U32")
>U列までコピーする必要はないような気がするのですが、これは
>なぜでしょう？
この印刷書式はA3になっており、G列以降にはCSVからのデータでは
ないものを、別途書き込むようになっています。
それでU列までのコピーが必要でした。

本当に長い間、ご迷惑をおかけして申し訳ありませんでした。
ありがとうございました。


	【62050】Re:行の挿入について（続き）

mori - 09/6/18(木) 21:25 -


	引用なし

	パスワード

かみちゃんさん

至らないところばかりで、ご迷惑をおかけして大変申し訳ありませんでした。
本当にありがとうございました。
以後、この掲示板に相談することがありましたら、かみちゃんさんのご指摘の
点を踏まえて、相談します。
申し訳ありませんでした。

Yukiさんのアドバイスは下から上へ・・・と言うものだったのですが、
kanabunさんのアドバイスは上から下へ・・・と言うものだったので、
お聞きしたかったのです。

私が表現したかったのは、かみちゃんさんのレイアウトの通りです。
CSVデータもかみちゃんさんが表して頂いた状態でした。

長い間、本当にありがとうございました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3467 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free