Excel VBA質問箱 IV

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

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


20192 / 76732 ←次へ | 前へ→

【61962】Re:行の挿入について
発言  mori  - 09/6/15(月) 9:48 -

引用なし
パスワード
   かみちゃん さん

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

Sub CreateMitsumori()

 Dim i          As Long
 Dim j          As Long
 Dim k          As Long
 Dim l          As Long
 Dim m          As Long
 Dim n          As Long
 Dim lngMaxRow      As Long
 Dim lngRow       As Long
 Dim blnFlag       As Boolean
 Dim lngCount      As Long
 Dim strName       As String
 Dim lngPresentRowIndex  As Long
 Dim lngRowX       As Long
 Dim lngRowY       As Long
 Dim strRangeValue    As String
 Dim lngFooterRowIndex  As Long

 
 Dim strGyoNO As String
 Dim strTekiyo As String
 Dim strSuryo As String
 Dim strTani As String
 Dim strTanka As String
 Dim strKingaku As String
 Dim strSyokei As String
 
 Dim strKakkoGyoNO As String
 Dim strKakkoKingaku As String
 Dim strTrimedTekiyo As String 'トリミング後
 Dim lngLength As Long
 Dim lngTekiyoLength As Long
 

 On Error GoTo Error_CreateMitsumori
  
 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
  
  lngPresentRowIndex = 4
  For lngRow = 31 To lngMaxRow
   strGyoNO = Worksheets("TMP1").Cells(lngRow, 1).Value  
   strTekiyo = Worksheets("TMP1").Cells(lngRow, 2).Value 
   strSuryo = Worksheets("TMP1").Cells(lngRow, 3).Value  
   strTani = Worksheets("TMP1").Cells(lngRow, 4).Value  
   strTanka = Worksheets("TMP1").Cells(lngRow, 5).Value  
   strKingaku = Worksheets("TMP1").Cells(lngRow, 6).Value 
   strSyokei = Worksheets("TMP1").Cells(lngRow, 6).Value 
   
   '()付行番号はCSV取込みすると−として認識されるので−を取り除きます
   If Left(strGyoNO, 1) = "-" Then
    lngLength = Len(strGyoNO)
    strKakkoGyoNO = Mid(strGyoNO, 2, lngLength - 1)
    strKakkoGyoNO = "'(" & strKakkoGyoNO & ")"         
    .Cells(lngPresentRowIndex, 1).Value = strKakkoGyoNO    
   Else
    .Cells(lngPresentRowIndex, 1).Value = strGyoNO             End If
   
   '文字列チェック
   strTrimedTekiyo = strTekiyo
   strTrimedTekiyo = StrConv(strTrimedTekiyo, 4)          '半角スペースがあった場合全角にします
   strTrimedTekiyo = Replace(strTrimedTekiyo, " ", "")      'トリミングします
   lngTekiyoLength = InStr(strTrimedTekiyo, "値引")        '文字列"値引"の検索をし、文字位置を返します。無かった場合0を返します
   If lngTekiyoLength > 0 Then
    strTrimedTekiyo = Mid(strTrimedTekiyo, lngTekiyoLength, 2)  '値引を抜き出します
   End If
   
   If strTrimedTekiyo = "合計" Then                '合計がある場合、小計欄のみに金額を挿入
    .Cells(lngPresentRowIndex, 2).Value = strTekiyo
    .Cells(lngPresentRowIndex, 6).Value = strKingaku
   ElseIf strTrimedTekiyo = "値引" Then
    .Cells(lngPresentRowIndex, 2).Value = strTekiyo
    .Cells(lngPresentRowIndex, 6).Value = strKingaku
   Else
    .Cells(lngPresentRowIndex, 2).Value = strTekiyo
    .Cells(lngPresentRowIndex, 3).Value = strSuryo
    .Cells(lngPresentRowIndex, 4).Value = strTani
    
   lngPresentRowIndex = lngPresentRowIndex + 1 'インデックスを加算

  Next
 
  End With
    
Exit_CreateMitsumori:
  Exit Sub

0 hits

【61954】行の挿入について mori 09/6/14(日) 18:59 質問
【61955】Re:行の挿入について かみちゃん 09/6/14(日) 19:14 発言
【61956】Re:行の挿入について mori 09/6/14(日) 19:34 発言
【61957】Re:行の挿入について かみちゃん 09/6/14(日) 19:46 発言
【61958】Re:行の挿入について mori 09/6/14(日) 20:02 発言
【61959】Re:行の挿入について かみちゃん 09/6/14(日) 20:13 発言
【61960】Re:行の挿入について mori 09/6/14(日) 20:37 発言
【61961】Re:行の挿入について かみちゃん 09/6/14(日) 21:00 発言
【61962】Re:行の挿入について mori 09/6/15(月) 9:48 発言
【61964】Re:行の挿入について かみちゃん 09/6/15(月) 12:42 発言
【61967】Re:行の挿入について mori 09/6/15(月) 14:44 発言
【61970】Re:行の挿入について kanabun 09/6/15(月) 15:09 発言
【61974】Re:行の挿入について mori 09/6/15(月) 15:32 お礼
【61996】Re:行の挿入について mori 09/6/16(火) 14:30 質問
【61998】Re:行の挿入について kanabun 09/6/16(火) 15:17 発言
【62001】Re:行の挿入について mori 09/6/16(火) 15:44 発言
【62005】Re:行の挿入について kanabun 09/6/16(火) 16:13 発言
【62008】Re:行の挿入について mori 09/6/16(火) 17:03 発言
【62009】Re:行の挿入について kanabun 09/6/16(火) 17:42 発言
【62013】Re:行の挿入について kanabun 09/6/17(水) 0:38 発言
【62016】Re:行の挿入について mori 09/6/17(水) 10:00 発言
【62017】Re:行の挿入について kanabun 09/6/17(水) 11:12 発言
【62019】Re:行の挿入について kanabun 09/6/17(水) 11:30 発言
【62021】Re:行の挿入について mori 09/6/17(水) 13:02 発言
【61971】Re:行の挿入について Yuki 09/6/15(月) 15:13 発言
【61976】Re:行の挿入について mori 09/6/15(月) 15:36 発言
【62015】Re:行の挿入について Yuki 09/6/17(水) 8:29 発言
【62026】Re:行の挿入について mori 09/6/17(水) 13:48 お礼
【61973】Re:行の挿入について かみちゃん 09/6/15(月) 15:32 発言
【61977】Re:行の挿入について mori 09/6/15(月) 15:52 お礼
【62012】Re:行の挿入について かみちゃん 09/6/16(火) 23:30 発言
【62025】Re:行の挿入について mori 09/6/17(水) 13:43 お礼

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