advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 13159 for 日付 (0.003 sec.)
[[20121023164130]]
#score: 2423
@digest: a2440db2eadf9428d64cfc3a38274ecb
@id: 60561
@mdate: 2012-10-24T03:53:08Z
@size: 5337
@type: text/plain
#keywords: 写. (84064), 付行 (67478), 帳. (65913), 額( (41612), rowarray (37491), 個貼 (26707), 付( (24908), 写as (21971), 目( (21469), 帳as (21016), 帳= (20299), 行, (20070), 写= (20030), 科目 (15903), 了帳 (15497), eflag (14996), 行in (14665), 複写 (14579), miyama (12025), 貼付 (11723), 目設 (9701), 先領 (8839), 定as (6907), 行= (6615), 行空 (6514), 行+ (5941), 行as (5112), k15 (5090), 金額 (4107), 付先 (2411), 明文 (2374), clearcontents (2147)
『貼付行を飛ばす』(miyama)
下記コードはsheet1の数値をsheet4に転記します。 17行目から2行空けて貼り付けるコードですが、6個貼り付けたら 60行目から2行空けて貼り付け、6個貼り付けたら 105行目から2行空けて貼り付け、6個貼り付けたら 150行目から1行空けて6個貼り付ける コードに修正したいのですが、ご指導お願いします 以下のような形です (e15)日付(k15)科目(n15)金額 (e17)日付(k15)科目(n17)金額 (e19)日付(k15)科目(n19)金額 (e21)日付(k15)科目(n21)金額 (e23)日付(k15)科目(n23)金額 (e25)日付(k15)科目(n25)金額 (e60)日付(k60)科目(n60)金額 (e62)日付(k62)科目(n62)金額 (e64)日付(k64)科目(n64)金額 (e66)日付(k66)科目(n66)金額 (e68)日付(k68)科目(n68)金額 (e70)日付(k70)科目(n70)金額 (e105)日付(k105)科目(n105)金額 (e107)日付(k107)科目(n107)金額 (e109)日付(k109)科目(n109)金額 (e111)日付(k111)科目(n111)金額 (e113)日付(k113)科目(n113)金額 (e115)日付(k115)科目(n115)金額 (e150)日付(k150)科目(n150)金額 (e152)日付(k152)科目(n152)金額 (e154)日付(k154)科目(n154)金額 (e156)日付(k156)科目(n156)金額 (e158)日付(k158)科目(n158)金額 (e160)日付(k160)科目(n160)金額 Sub 貼り付け() Dim 行 As Long Dim 貼付行 As Long Dim 科目設定 As String Dim 帳 As Worksheet Dim 複写 As Worksheet Set 帳 = Worksheets("sheet4") Set 複写 = Worksheets("sheet1") 行 = 3 貼付行 = 17 Do Until 複写.Cells(行, 1).Value = "" '1列目に値が無ければ終了 帳.Cells(貼付行, 5).Value = 複写.Cells(行, 1).Value If Sheets("sheet1").Range("a15").Value <> "" Then 帳.Cells(貼付行, 11).Value = 複写.Cells(行, 10).Value End If 帳.Cells(貼付行, 14).Value = 複写.Cells(行, 9).Value 貼付行 = 貼付行 + 2 Loop End Sub Excel2007 Windows 7 ---- 回答の前に。 貼り付け元の行変数 "行" はカウントアップしていないけど、↑のコードは実際に動かしたコードじゃないんだね? 追記)説明文とコードは17行目からとなっているけど、サンプルは15行目からになっているね。 実際は、どちらが正しいの? (ぶらっと) ---- ぶらっと様 申し訳ありません 行 = 行 + 1 が抜けていました、申し訳ありません Sub 貼り付け() Dim 行 As Long Dim 貼付行 As Long Dim 科目設定 As String Dim 帳 As Worksheet Dim 複写 As Worksheet Set 帳 = Worksheets("sheet4") Set 複写 = Worksheets("sheet1") 行 = 3 貼付行 = 17 Do Until 複写.Cells(行, 1).Value = "" '1列目に値が無ければ終了 帳.Cells(貼付行, 5).Value = 複写.Cells(行, 1).Value If Sheets("sheet1").Range("a15").Value <> "" Then 帳.Cells(貼付行, 11).Value = 複写.Cells(行, 10).Value End If 帳.Cells(貼付行, 14).Value = 複写.Cells(行, 9).Value 貼付行 = 貼付行 + 2 行 = 行 + 1 Loop End Sub >説明文とコードは17行目からとなっているけど、サンプルは >15行目からになっているね。 申し訳ありません17です miyama ---- >150行目から1行空けて6個貼り付ける サンプルでは、ここも2行おきなので、サンプルが正しいとして。 転記元領域等、コードから推測しているので誤解していたら指摘乞う。 Sub Sample() Dim rowArray As Variant Dim x As Long Dim eFlag As Boolean Dim 行 As Long Dim 貼付行 As Variant '★型変更 Dim 帳 As Worksheet Dim 複写 As Worksheet Application.ScreenUpdating = False Set 帳 = Worksheets("Sheet4") Set 複写 = Worksheets("Sheet1") rowArray = Array(17, 60, 105, 150) 行 = 3 '貼付先領域のクリア For Each 貼付行 In rowArray 帳.Cells(貼付行, "E").Resize(11).ClearContents 帳.Cells(貼付行, "K").Resize(11).ClearContents 帳.Cells(貼付行, "N").Resize(11).ClearContents Next '貼付実行 For Each 貼付行 In rowArray For x = 1 To 6 If IsEmpty(複写.Cells(行, 1).Value) Then eFlag = True Exit For End If 帳.Cells(貼付行, "E").Value = 複写.Cells(行, "A").Value 帳.Cells(貼付行, "K").Value = 複写.Cells(行, "J").Value 帳.Cells(貼付行, "N").Value = 複写.Cells(行, "I").Value 行 = 行 + 1 貼付行 = 貼付行 + 2 Next If eFlag Then Exit For Next 帳.Select Application.ScreenUpdating = True MsgBox "貼付完了" End Sub (ぶらっと) ---- ぶらっと様 ありがとうございます 感謝です 1つお願いしてもよろしいでしょうか 貼付先領域のクリアとして、下記コードですが,大変便利です いちいちセルを削除するコードが必要ないですから。 ただ、エラーになります。 説明不足でした。 "e"は結合セルでして、e列からJ列 "k"はk列からm列 "n"はn列からx列 です 結合されたセルの一部を変更することはできません とエラー表示されます どうかいまひとつご指導お願いします For Each 貼付行 In rowArray 帳.Cells(貼付行, "E").Resize(11).ClearContents 帳.Cells(貼付行, "K").Resize(11).ClearContents 帳.Cells(貼付行, "N").Resize(11).ClearContents Next miyama ---- Resize(11)はResize(11,1)の略です。 それぞれ列数を勘定して Resize(11,n)の n の数値を設定してください。 (みやほりん) ---- 衝突 みやほりんさんと同じ回答だけど 帳.Cells(貼付行, "E").Resize(11, 6).ClearContents 帳.Cells(貼付行, "K").Resize(11, 3).ClearContents 帳.Cells(貼付行, "N").Resize(11, 11).ClearContents (ぶらっと) ---- みやほりん様 ありがとうございます ぶらっと様 たいへん時間おかけしました ありがとうございます miyama ...
http://www.excel.studio-kazu.jp/wiki/kazuwiki/201210/20121023164130.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608132 words.

訪問者:カウンタValid HTML 4.01 Transitional