Excel VBA質問箱 IV

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

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


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

5886 / 76807

←次へ　｜　前へ→


	【76528】Re:コードを短くしたい

β - 14/12/26(金) 22:33 -


	引用なし

	パスワード

▼ゆーあさん：

それでは、先ほどアップしたSaampleに、追加で書いてもらったコード要件を
カミして再掲。ただし、転記コードは３行しか書いてません。残りの４７行は
そちらで追加して完成させてください。

で、これでもいいと思いますが、【コードを整理して短く】した　Sample2 も
あわせてアップいます。コードも短くしていますが、５セル１セットの転記、
Sampleのほうではコードも５行（つまりセルに５回書き込み）あるのですが
Sample2では２行（つまりせるにへの書き込み回数は１セット２回）にしています。

まず、Sample を自分のものとして理解したのちに Sample2　に取り組んでください。

Sub Sample()
　　'元ブックと元シート
　　Dim dBK As Workbook
　　Dim dSh As Worksheet
　　'転記ブックと転記シート
　　Dim nBK As Workbook
　　Dim nSh As Worksheet
　　
　　Set dBK = ThisWorkbook
　　Set dSh = dBK.Sheets("Sheet3")
　　
　　Set nBK = Workbooks.Add(xlWBATWorksheet)
　　Set nSh = nBK.Sheets(1)
　　nSh.Name = "ﾃﾞｰﾀ抽出"
　　
　　Application.ScreenUpdating = False　　　'セル書き込みに伴う画面再描画の抑止（処理時間の短縮化）
　　
　　nSh.Range("B6").Value = dSh.Range("A1").Value
　　nSh.Range("C6").Value = dSh.Range("A2").Value
　　nSh.Range("D6").Value = dSh.Range("A3").Value
　　
　　　　　　'
　　　　　　'省略　ゆーあさんのほうで、コードを追加して完成させてください
　　　　　　'
　　　　　　
End Sub

Sub Sample2()
　　Dim i As Long
　　Dim j As Long
　　'元ブックと元シート
　　Dim dBK As Workbook
　　Dim dSh As Worksheet
　　'転記ブックと転記シート
　　Dim nBK As Workbook
　　Dim nSh As Worksheet
　　
　　Set dBK = ThisWorkbook
　　Set dSh = dBK.Sheets("Sheet3")
　　
　　Set nBK = Workbooks.Add(xlWBATWorksheet)
　　Set nSh = nBK.Sheets(1)
　　nSh.Name = "ﾃﾞｰﾀ抽出"
　　
　　Application.ScreenUpdating = False
　　
　　j = 6
　　For i = 1 To 46 Step 5
　　　　nSh.Cells(j, "B").Resize(, 4).Value = WorksheetFunction.Transpose(dSh.Cells(i, "A").Resize(4).Value)
　　　　nSh.Cells(j, "H").Value = dSh.Cells(i + 4, "A").Value
　　　　j = j + 5
　　Next
　　
End Sub

1 hits

▼

【76525】コードを短くしたい ゆーあ 14/12/26(金) 15:42