Excel VBA質問箱 IV

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

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


20124 / 76732 ←次へ | 前へ→

【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

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

68 hits

【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 お礼

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