Excel VBA質問箱 IV

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

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


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

29654 / 76732

←次へ　｜　前へ→


	【52355】余計な文字が出てしまいます

ゆばーば - 07/11/10(土) 17:50 -


	引用なし

	パスワード

Sheet1のリストをSheet2のタックシールに配置する方法を
先日こちらで教えていただき、少し手を加えましたところ、最後のタックシールに余分な文字が出てしまいます。どうすれば出なくなるのか、全然解かりません。
どうかお知恵をお貸し下さい。

Dim lngRow As Long
　Dim lngTuckRow As Long
　Dim cntCT As Integer

　lngTuckRow = 1
　'Sheet1の5行目～30行目までを処理する場合
　For lngRow = 5 To 30
　　Sheets("Sheet2").Range("A" & lngTuckRow).Value = Sheets("Sheet1").Range("A" & lngRow).Value
　　Sheets("Sheet2").Range("A" & lngTuckRow).Interior.ColorIndex = 1
　　Sheets("Sheet2").Range("A" & lngTuckRow).Font.ColorIndex = 2
　　Sheets("Sheet2").Range("A" & lngTuckRow + 1).Value = Sheets("Sheet1").Range("E" & lngRow).Value
　　Sheets("Sheet2").Range("A" & lngTuckRow + 2).Value = Sheets("Sheet1").Range("B" & lngRow).Value
　　Sheets("Sheet2").Range("A" & lngTuckRow + 3).Value = Sheets("Sheet1").Range("C" & lngRow).Value
　　Sheets("Sheet2").Range("A" & lngTuckRow + 4).Value = Sheets("Sheet1").Range("D" & lngRow).Value & "　" & Range("F" & lngRow) & "入"

　　cntCT = Sheets("Sheet1").Range("G" & lngRow).Value
　　If cntCT >= 2 Then
　　　Sheets("Sheet2").Range("A" & lngTuckRow).Resize(6).Copy Sheets("Sheet2").Range("B" & lngTuckRow)
　　　If cntCT >= 2 Then
　　　　Sheets("Sheet2").Range("A" & lngTuckRow).Resize(6, 2).Copy _
　　　　　Sheets("Sheet2").Range("A" & lngTuckRow).Resize(6 * Int((cntCT + 1) / 2), 2)
　　　End If
　　　'C/T数が奇数の場合は、B列の最終行から6行を消去
　　　If cntCT Mod 2 = 1 Then
　　　　Sheets("Sheet2").Range("B" & lngTuckRow).Offset(6 * Int(cntCT / 2)).Resize(6).ClearContents
　　　End If
　　End If
　　lngTuckRow = lngTuckRow + 6 * (Int((cntCT + 1) / 2))
　Next
　Sheet2.Select
　
End Sub

2 hits

▼

【52355】余計な文字が出てしまいます ゆばーば 07/11/10(土) 17:50

≪