Excel VBA質問箱 IV

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

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


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

1910 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【71061】ifの整理 ｸﾘｼｭﾌｧｰ 12/1/27(金) 14:11

【71062】Re:ifの整理 Yuki 12/1/27(金) 14:31

【71063】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/27(金) 14:44

【71064】Re:ifの整理 ちん 12/1/27(金) 15:59

【71065】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/27(金) 16:47

【71066】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/27(金) 17:09

【71068】Re:ifの整理 kanabun 12/1/27(金) 17:34

【71069】Re:ifの整理 kanabun 12/1/27(金) 17:39

【71070】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/27(金) 18:43

【71071】Re:ifの整理 Hirofumi 12/1/27(金) 20:37

【71072】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/27(金) 20:50

【71073】Re:ifの整理 Hirofumi 12/1/27(金) 21:18

【71082】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/28(土) 8:18

【71083】Re:ifの整理 Hirofumi 12/1/28(土) 9:26

【71084】Re:ifの整理 Hirofumi 12/1/28(土) 9:32

【71085】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/28(土) 9:38

【71086】Re:ifの整理 kanabun 12/1/28(土) 10:55

【71087】Re:ifの整理 ｸﾘｼｭﾌｧｰ 12/1/28(土) 11:35


	【71061】ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/27(金) 14:11 -


	引用なし

	パスワード

Private Sub CommandButton1_Click()

　If CheckBox1.Value = True Then
　Cells(行, "F").Copy Sheet2.Range("C6:I7")
　End If
　If CheckBox2.Value = True Then
　Cells(行, "G").Copy Sheet2.Range("K6:Q7")
　End If
　If CheckBox3.Value = True Then
　Cells(行, "H").Copy Sheet2.Range("S6:Y7")
　End If
　If CheckBox4.Value = True Then
　Cells(行, "I").Copy Sheet2.Range("AA6:AG7")
　End If
　If CheckBox5.Value = True Then
　Cells(行, "J").Copy Sheet2.Range("C8:I9")
　End If
　If CheckBox6.Value = True Then
　Cells(行, "K").Copy Sheet2.Range("K8:Q9")
　End If
　If CheckBox7.Value = True Then
　Cells(行, "L").Copy Sheet2.Range("S8:Y9")
　End If

End Sub

よろしくお願いいたします
ifをまとめるにはどうしたらよろしいでしょうか
また、sheet2の貼り付けるかセルですが、ﾁｪｯｸﾎﾞｯｸｽが入っていないときは詰めて貼り付けたいのですが、どうしたら宜しいでしょうか
宜しくお願いいたします


	【71062】Re:ifの整理

Yuki - 12/1/27(金) 14:31 -


	引用なし

	パスワード

▼ｸﾘｼｭﾌｧｰさん：
こんにちは。
貼り付け先のアドレスに規則性がないので簡素化は無理だとおもいます、
今のままでは不具合があるのですか？


	【71063】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/27(金) 14:44 -


	引用なし

	パスワード

▼Yuki さん：
こんにちは、ありがとうございます

チェックされない項目の箇所が空白になってしまうため
貼り付け先が歯抜けになってしまって格好がわるいです

貼り付け先は４列（C6からAA6で次がC8からAA8の列で４列）で折り返します

なんとかならないでしょうか
宜しくお願いいたします


	【71064】Re:ifの整理

ちん - 12/1/27(金) 15:59 -


	引用なし

	パスワード

▼ｸﾘｼｭﾌｧｰさん：こんにちわ、ちんといいます。
if文をまとめる？ですが、
if内の処理が１命令であれば、
>　If CheckBox1.Value = True Then
>　Cells(行, "F").Copy Sheet2.Range("C6:I7")　　'<--１命令　
>　End If

If CheckBox1.Value = True Then Cells(行, "F").Copy Sheet2.Range("C6:I7")
If CheckBox2.Value = True Then Cells(行, "G").Copy Sheet2.Range("K6:Q7")
If CheckBox3.Value = True Then Cells(行, "H").Copy Sheet2.Range("S6:Y7")
と、なります。

シートの列は、Ａ列から1,2,3　となりますので、
Ｆ列は6です。

RETU=6　　とし、
　If CheckBox1.Value = True Then Cells(行, RETU).Copy Sheet2.Range("C6:I7"):　RETU=RETU+1
　※２命令あるときは、：でつなげていきます。
　If CheckBox2.Value = True Then
　Cells(行, RETU).Copy Sheet2.Range("K6:Q7"): RETU=RETU+1
　End If
　If CheckBox3.Value = True Then
　Cells(行, RETU).Copy Sheet2.Range("S6:Y7") : RETU=RETU+1
　End If
　If CheckBox4.Value = True Then
　Cells(行, RETU).Copy Sheet2.Range("AA6:AG7")
　RETU=RETU+1
　End If
　If CheckBox5.Value = True Then
　Cells(行, RETU).Copy Sheet2.Range("C8:I9")
　RETU=RETU+1
　End If
　If CheckBox6.Value = True Then
　Cells(行, RETU).Copy Sheet2.Range("K8:Q9")
　RETU=RETU+1
　End If
　If CheckBox7.Value = True Then
　Cells(行, RETU).Copy Sheet2.Range("S8:Y9")
　RETU=RETU+1
　End If

勘違いしてたらごめんなさい。参考までに・・・


	【71065】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/27(金) 16:47 -


	引用なし

	パスワード

▼ちんさん：
ありがとうございます

読み込みのセルは（F～V）です
書き込むセルが("C6:I7")～("AA8:AG9")なのですが

書き込むセルが各々指定しまっているので
たとえばCheckBox5のチェックが入らなかった場合("C8:I9")だけが歯抜けになってしまいます
その場合、CheckBox6の(行, K)が("C8:I9")挿入したいです
以降のデーターも詰めて表示したいのですが

説明が下手ですみません


	【71066】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/27(金) 17:09 -


	引用なし

	パスワード

▼ｸﾘｼｭﾌｧｰさん：
>▼ちんさん：
>ありがとうございます
>
If CheckBox1.Value = True Then Cells(行, "F").Copy Sheet2.Range("C6:I7")

　If CheckBox2.Value = True Then Cells(行, "G").Copy Sheet2.Range("K6:Q7")

　If CheckBox3.Value = True Then Cells(行, "H").Copy Sheet2.Range("S6:Y7")

　If CheckBox4.Value = True Then Cells(行, "I").Copy Sheet2.Range("AA6:AG7")
　If CheckBox5.Value = True Then Cells(行, "J").Copy Sheet2.Range("C8:I9")
　If CheckBox6.Value = True Then Cells(行, "K").Copy Sheet2.Range("K8:Q9")
　If CheckBox7.Value = True Then Cells(行, "L").Copy Sheet2.Range("S8:Y9")
　If CheckBox8.Value = True Then Cells(行, "M").Copy Sheet2.Range("AA8:AG9")
　If CheckBox9.Value = True Then Cells(行, "N").Copy Sheet2.Range("C10:I11")）
　If CheckBox10.Value = True Then Cells(行, "O").Copy Sheet2.Range("K10:Q11")
　If CheckBox11.Value = True Then Cells(行, "P").Copy Sheet2.Range("S10:Y11")
　If CheckBox12.Value = True Then Cells(行, "Q").Copy Sheet2.Range("AA10:AG11")
　If CheckBox13.Value = True Then Cells(行, "R").Copy Sheet2.Range("C12:I13")
　If CheckBox14.Value = True Then Cells(行, "S").Copy Sheet2.Range("K12:Q13")
　If CheckBox15.Value = True Then Cells(行, "T").Copy Sheet2.Range("S12:Y13")
　If CheckBox16.Value = True Then Cells(行, "U").Copy Sheet2.Range("AA12:AG13")
　If CheckBox17.Value = True Then Cells(行, "V").Copy Sheet2.Range("C14:I15")

ありがとうございます
こんな形までできました

歯抜けになってしまうのだけなんとかできればありがたいのですが


	【71068】Re:ifの整理

kanabun - 12/1/27(金) 17:34 -


	引用なし

	パスワード

▼ｸﾘｼｭﾌｧｰさん：おじゃまさまです >歯抜けになってしまうのだけなんとかできればありがたいのですが Copy先セルを覚えておいて、Copyするごとに順に移動していったらどうでしょう（↓ Copy元シートを Sheet1 と仮定しています） Option Explicit Private Sub CommandButton1_Click() 　Dim c As Range 　Dim i As Long 　Dim 行 As Long 　行 = 2 '「行」はどこでどのように決まるのか？分かりません。　Set c = Sheet2.Range("C6") 　For i = 1 To 7 　　　If Me("CheckBox" & i).Value Then 　　　　　Sheet1.Cells(行, i + 5).Copy c.Resize(2, 7) 　　　　　NextCell c 　　　End If 　Next End Sub ’// Copy先セル移動 Private Sub NextCell(ByRef c As Range) 　　If c.Column < 27 Then 　　　　Set c = c.Offset(, 8) 　　Else 　　　　Set c = c.Worksheet.Cells(c.Row + 2, "C") 　　End If End Sub かんちがいしてるかな？


	【71069】Re:ifの整理

kanabun - 12/1/27(金) 17:39 -


	引用なし

	パスワード

> If CheckBox17.Value = True CheckBox は 17個あるんですか？もしそうなら > 　For i = 1 To 7 は　　　For i = 1 To 17 に変更ですね


	【71070】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/27(金) 18:43 -


	引用なし

	パスワード

▼kanabun さん：
Private Sub CommandButton1_Click()

　
　Dim c As Range
　Dim i As Long
　Dim 行 As Long
　行 = ActiveCell.Row
　Set c = Sheet2.Range("C6:I7")
　For i = 1 To 17
　　　If Me("CheckBox" & i).Value Then
　　　　　Sheet12.Cells(行, i + 5).Copy c.Resize(2, 7)
　　　　　NextCell c
　　　End If
　Next

ありがとうございます
一歩近づきましたが、("C6:I7")等が結合されたセルの為かチェックボタンが二個以上指定すると「結合されたセルの一部うぃ変更することはできません」とでてしまいます

自分でもよく考えてみます

もし、わかりましたらご教授おねがいいたします


	【71071】Re:ifの整理

Hirofumi - 12/1/27(金) 20:37 -


	引用なし

	パスワード

結合セルの具合とチェックがに所をどう詰めるかが今一解りませんが？
こんなのでは？

Private Sub CommandButton1_Click()

　　Dim i As Long
　　Dim j As Long
　　Dim lngRow As Long
　　Dim lngColumn As Long
　　Dim 行 As Long
　　
　　行 = 1
　　
　　For i = 1 To 17
　　　　If Me.Controls("CheckBox" & i) Then
　　　　　　lngColumn = (j Mod 4) * 8
　　　　　　lngRow = (j \ 4) * 2
　　　　　　ActiveSheet.Cells(行, 6 + i - 1).Copy _
　　　　　　　　　　Worksheets("Sheet2").Cells(6 + lngRow, _
　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)
　　　　　　j = j + 1
　　　　End If
　　Next i
　　　　　　
End Sub


	【71072】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/27(金) 20:50 -


	引用なし

	パスワード

▼Hirofumi さん：
>結合セルの具合とチェックがに所をどう詰めるかが今一解りませんが？
>こんなのでは？
>
>Private Sub CommandButton1_Click()
>
>　　Dim i As Long
>　　Dim j As Long
>　　Dim lngRow As Long
>　　Dim lngColumn As Long
>　　Dim 行 As Long
>　　
>　　行 = 1
>　　
>　　For i = 1 To 17
>　　　　If Me.Controls("CheckBox" & i) Then
>　　　　　　lngColumn = (j Mod 4) * 8
>　　　　　　lngRow = (j \ 4) * 2
>　　　　　　ActiveSheet.Cells(行, 6 + i - 1).Copy _
>　　　　　　　　　　Worksheets("Sheet2").Cells(6 + lngRow, _
>　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)
>　　　　　　j = j + 1
>　　　　End If
>　　Next i
>　　　　　　
>End Sub

遅い時間にありがとうございます

ActiveSheet.Cells(行, 6 + i - 1).Copy _
>　　　　　　　　　　Worksheets("Sheet2").Cells(6 + lngRow, _
>　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)
でﾃﾞﾊﾞｯｸﾞがかかてしまいます
今日のとこは、あきらめて明日また挑戦してみます
ありがとうございます


	【71073】Re:ifの整理

Hirofumi - 12/1/27(金) 21:18 -


	引用なし

	パスワード

>ActiveSheet.Cells(行, 6 + i - 1).Copy _
>>　　　　　　　　　　Worksheets("Sheet2").Cells(6 + lngRow, _
>>　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)
>でﾃﾞﾊﾞｯｸﾞがかかてしまいます

で、エラーの内容は何ですか？

もし、
「実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラーです」
なら、

　　Dim 行 As Long
　　
　　行 = 1
　　
　　For i = 1 To 17

の変数「行」が0に成っていませんか？


	【71082】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/28(土) 8:18 -


	引用なし

	パスワード

▼Hirofumi さん：
おはようございます

昨日はありがとうございます

ﾃﾞﾊﾞｯｸﾞですが「ｲﾝﾃﾞｯｸｽが有効範囲ではありません」とでます
貼り付け先のセルが結合されてるせいでしょうか・・・・

よろしくお願いいたします


	【71083】Re:ifの整理

Hirofumi - 12/1/28(土) 9:26 -


	引用なし

	パスワード

>　 ▼Hirofumi さん：
>おはようございます
>
>昨日はありがとうございます
>
>
>ﾃﾞﾊﾞｯｸﾞですが「ｲﾝﾃﾞｯｸｽが有効範囲ではありません」とでます
>貼り付け先のセルが結合されてるせいでしょうか・・・・
>
>よろしくお願いいたします

　　　　　　ActiveSheet.Cells(行, 6 + i - 1).Copy _
　　　　　　　　　　Worksheets("Sheet2").Cells(6 + lngRow, _
　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)

の部分で「ｲﾝﾃﾞｯｸｽが有効範囲ではありません」となるのは

1、ActiveSheetが無いか？　→　こんな事は無い筈でしょ
2、Worksheets("Sheet2")が無い　→　可能性大！！

しか考えられないので"Sheet2"と言う名前のシートが無いのでは？


	【71084】Re:ifの整理

Hirofumi - 12/1/28(土) 9:32 -


	引用なし

	パスワード

あ！善く見ると、ｸﾘｼｭﾌｧｰさんのコードでは

　　Set c = Sheet2.Range("C6:I7")

としているので。オブジェクト名がSheet2のシートの名前が"Sheet2"では無く
別の名前に成っている様ですね
因って、

　　　　　　ActiveSheet.Cells(行, 6 + i - 1).Copy _
　　　　　　　　　　Sheet2.Cells(6 + lngRow, _
　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)

とするか、

　　　　　　ActiveSheet.Cells(行, 6 + i - 1).Copy _
　　　　　　　　　　Worksheets("実際のシート名").Cells(6 + lngRow, _
　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)

にして見て下さい


	【71085】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/28(土) 9:38 -


	引用なし

	パスワード

▼Hirofumi さん：

Private Sub CommandButton1_Click()
　
　　Dim i As Long
　　Dim lngRow As Long
　　Dim lngColumn As Long
　　Dim 行 As Long
　　行 = ActiveCell.Row
　
　　For i = 1 To 18
　　　　If Me.Controls("CheckBox" & i) Then
　　　　　　lngColumn = (j Mod 4) * 8
　　　　　　lngRow = (j \ 4) * 2
　　　　　　ActiveSheet.Cells(行, 6 + i - 1).Copy _
　　　　　　　　　　Sheet2.Cells(6 + lngRow, _
　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)
　　　　　　j = j + 1
　　　　End If
　　Next i　　'上記の記述でうまくいきました＜（_　_）＞
　　　　　　　'下記の記述をいれますと i As Integerでﾃﾞﾊﾞｯｸﾞになってしまいます
　
　
　Dim myMSG As String
　　Dim myFlg As Boolean, i As Integer
　　　　myFlg = False
　　　　For x = 1 To 18
　　　　　　If Me.Controls("CheckBox" & x).Value = True Then
　　　　　　　　myMSG = myMSG & Me.Controls("CheckBox" & x).Caption & vbCrLf
　　　　　　　　myFlg = True
　　　　　　End If
　　　　Next x
　　　　If myFlg = True Then
　　　　　　
　　　　　　myMSG = myMSG & "宛てで宜しいですか？"
　　　　　　
　　　　　　
　　　　Else
　　　　　　myMSG = "いずれにもチェックが入っていません"
　　　　End If
　　　　MsgBox myMSG
　　　　
　
　End Sub

宜しくお願いいたします


	【71086】Re:ifの整理

kanabun - 12/1/28(土) 10:55 -


	引用なし

	パスワード

▼ｸﾘｼｭﾌｧｰさん： Hirofumi さんではありませんが、失礼。 >　　　　　　　'下記の記述をいれますと i As Integerでﾃﾞﾊﾞｯｸﾞになってしまいます >　　 Dim myMSG As String >　　Dim myFlg As Boolean, i As Integer あるプロシージャ内で、同じ名前の変数を2回、それもデータ型を変えて宣言することはできません。一番最初に >　　Dim i As Long と宣言しているから、あとの >　　Dim　i As Integer は無意味ってことなのでは？それと、ぼくのコード、結合セルでエラーとのことですが、　　For i = 1 To 17 '　 or　 18 ? 　　　If Me("CheckBox" & i).Value Then 　　　　　Sheet1.Cells(行, i + 5).Copy c　 '← ◆ここを修正　　　　　NextCell c 　　　End If のようにしたら、そのままで動きませんか？


	【71087】Re:ifの整理

ｸﾘｼｭﾌｧｰ - 12/1/28(土) 11:35 -


	引用なし

	パスワード

▼kanabun さん：

Dim i As Long
　　Dim lngRow As Long
　　Dim lngColumn As Long
　　Dim 行 As Long
　　行 = ActiveCell.Row
　
　　For i = 1 To 19
　　　　If Me.Controls("CheckBox" & i) Then
　　　　　　lngColumn = (j Mod 4) * 8
　　　　　　lngRow = (j \ 4) * 2
　　　　　　ActiveSheet.Cells(行, 6 + i - 1).Copy _
　　　　　　　　　　Sheet2.Cells(6 + lngRow, _
　　　　　　　　　　　　　　　　3 + lngColumn).Resize(2, 7)
　　　　　　j = j + 1
　　　　End If
　　Next i

以上で動作しました
皆様ありがとうございました
ほんとに感謝です


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

1910 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free