Excel VBA質問箱 IV

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

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


1484 / 13644 ツリー ←次へ | 前へ→

【74118】空欄判定で2セル下にづらしたい場合 桃園 13/4/19(金) 10:42 質問[未読]
【74119】Re:空欄判定で2セル下にづらしたい場合 UO3 13/4/19(金) 12:07 発言[未読]
【74120】Re:空欄判定で2セル下にづらしたい場合 桃園 13/4/19(金) 12:58 質問[未読]
【74121】Re:空欄判定で2セル下にづらしたい場合 UO3 13/4/19(金) 14:10 発言[未読]
【74123】Re:空欄判定で2セル下にづらしたい場合 桃園 13/4/19(金) 14:33 お礼[未読]

【74118】空欄判定で2セル下にづらしたい場合
質問  桃園  - 13/4/19(金) 10:42 -

引用なし
パスワード
   マクロの記録を使っていろいろやってみたのですが・・・
こんがらがってわからなくなりましたのでお助けください。

1、変数を使って、A9のセルが空欄なら記入、
空欄でない場合はA11のセルに記入のループ
と2行づつ判定する文を作るつもりだったのですが
変数を当てはめるとどうもおかしいことに・・・
A=9、B=10の変数を使用して
Do White Cells(A, 1)= ""
A=A+2
B=B+2
Loop
で判定させようと思ったのですがうまくいきません。

2、1.の変数を使用してセルを結合することは可能ですか?
Worksheets("sheet2").Range("A9:G10,H9:J10,K9:N10,O9:Q10,R9:T9,R10:T10").Select
↓変数を使って複数のセルをばらばらに結合したい
Worksheets("sheet2").Range(Cells(A,1)(B,8)),(Cells(A,9)(B,11)),(Cells(A,12)(B,15)),(Cells(A,16)(B,18)),(Cells(A,19)(A,21)),(Cells(B,19)(B,21)).Select

無意味な文も多数あると思いますが
いまいち理解してない部分が多いのでご教授よろしくお願いします。

※ボタンはSheet1にあります。
--------------------------------------------------------------
Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  If Range("AK11") = 1 Then
    Range("A49:W50").Select
    Sheets("sheet2").Select
    Worksheets("sheet2").Range("A9:W10").Select
  With Selection
    .VerticalAlignment = xlCenter
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
  End With
    Sheets("sheet1").Select
    Range("A49:W50").Select
    Selection.Copy
    Sheets("sheet2").Select
    Worksheets("sheet2").Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Worksheets("sheet2").Range("A9:G10,H9:J10,K9:N10,O9:Q10,R9:T9,R10:T10").Select
    Worksheets("sheet2").Range("T10").Activate
    Application.CutCopyMode = False
  With Selection
    .VerticalAlignment = xlCenter
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = True
  End With
    Worksheets("sheet2").Range("V9:V10").Select
    Selection.NumberFormatLocal = "yyyy""年""m""月"";@"
    MsgBox "完了", vbOKOnly, "確認"
    Else
    MsgBox "内訳がありません。", vbCritical, "エラー"
  End If
End Sub

【74119】Re:空欄判定で2セル下にづらしたい場合
発言  UO3  - 13/4/19(金) 12:07 -

引用なし
パスワード
   ▼桃園 さん:

こんにちは
アップされたコードをそのまま、整理すると以下のようになりますので、
ここから出発されたらよろしいと思うのですが、

>1、変数を使って、A9のセルが空欄なら記入、
>空欄でない場合はA11のセルに記入のループ
>と2行づつ判定する文を作るつもりだったのですが
>変数を当てはめるとどうもおかしいことに・・・
>A=9、B=10の変数を使用して
>Do White Cells(A, 1)= ""
>A=A+2
>B=B+2
>Loop

よく理解できません。
具体的に、シートのどのセル領域の各セルが、そうであれば、どのシートのどこに何をセットしたいと
言葉で具体的に説明いただけませんか?

>2、1.の変数を使用してセルを結合することは可能ですか?

これについても、【1.の変数】含めて 1. そのものがよくわからないので
コメントしづらいですねぇ。

Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  If Range("AK11") = 1 Then
    With Worksheets("sheet2").Range("A9:W10")
      .VerticalAlignment = xlCenter
      .Orientation = 0
      .AddIndent = False
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
    End With
    Worksheets("sheet2").Range("A9:W10").Value = Range("A49:W50").Value
    With Worksheets("sheet2").Range("A9:G10,H9:J10,K9:N10,O9:Q10,R9:T9,R10:T10")
      .VerticalAlignment = xlCenter
      .Orientation = 0
      .AddIndent = False
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = True
    End With
    Worksheets("sheet2").Range("V9:V10").NumberFormatLocal = "yyyy""年""m""月"";@"
    MsgBox "完了", vbOKOnly, "確認"
  Else
    MsgBox "内訳がありません。", vbCritical, "エラー"
  End If
End Sub

【74120】Re:空欄判定で2セル下にづらしたい場合
質問  桃園  - 13/4/19(金) 12:58 -

引用なし
パスワード
   こんにちわ
UO3さんコメントとご指摘ありがとうございます。
説明不十分過ぎて申しわけないです。

簡単に言うとsheet1で入力した内容(A49:W50)をsheet2の一覧表((A9:W10)〜(A11:W12)〜省略)
に出力したいと思っているのですが、
現状の文ですと、結果を出力すると同じ箇所に上書きされるので
それを回避するために2セルづらして出力する文へと変更を考えていました。
※ここで2セルづらす理由は(A9:G10,H9:J10,K9:N10,O9:Q10,R9:T9,R10:T10)が複雑に結合している為です。
一覧表は既に雛形がある為、一覧表に合わせて作成しています。
なので変なセル位置になってしまいました。
例文を作ろうと思ったのですが
パッと考えられなかったのでそのまま投稿しました。
すみません・・・

1、の件はsheet2(A9,W10)が貼付先なのでここを空欄かどうか判定してA9は既に入力済みの場合、(A11:W12)のようにどんどんずれるようにしようと思っています。

2、の件は普通にWith Worksheets("sheet2").Range("A9:G10,H9:J10,K9:N10,O9:Q10,R9:T9,R10:T10")
に変数を当てた場合の文章がわからなかったので質問させていただきました。

数々の説明不備の中、ご返信大変有難く思います。
まだ不備等々あると思いますがよろしくお願いします。

【74121】Re:空欄判定で2セル下にづらしたい場合
発言  UO3  - 13/4/19(金) 14:10 -

引用なし
パスワード
   ▼桃園 さん:

まだ要件がクリアには理解できていないところもあるかもです。
A列には、何かしらの値があると決めつけています。

Private Sub CommandButton1_Click()
  Dim z As Long
  
  If Range("AK11") <> 1 Then
    MsgBox "内訳がありません。", vbCritical, "エラー"
    Exit Sub
  End If
  
  Application.ScreenUpdating = False
  
  With Sheets("Sheet2")
    z = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    If z < 9 Then
      z = 9
    Else
      If z Mod 2 = 0 Then z = z + 1
    End If
    With .Rows(z).Resize(2).Columns("A:W")
      .MergeCells = False   'いったん解除。念のため
      .Value = Range("A49:W50").Value
      With .Range("A1:G2,H1:J2,K1:N2,O1:Q2,R1:T1,R2:T2")
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        Application.DisplayAlerts = False '念のため
        .Merge
        Application.DisplayAlerts = True
      End With
      .Range("V1:V2").NumberFormatLocal = "yyyy""年""m""月"";@"
    End With
    .Select
  End With
  
  Application.ScreenUpdating = True
  
  MsgBox "完了", vbOKOnly, "確認"
End Sub

【74123】Re:空欄判定で2セル下にづらしたい場合
お礼  桃園  - 13/4/19(金) 14:33 -

引用なし
パスワード
   説明不備の中
お早い回答有難うございます。
問題なく動きました。

わからない部分等は、下記文を参考にして
どのようにして動いているか理解して扱っていこうと思います。

大変感謝致します。
また、ご縁がありましたらよろしくお願いします。

>Private Sub CommandButton1_Click()
>  Dim z As Long
>  
>  If Range("AK11") <> 1 Then
>    MsgBox "内訳がありません。", vbCritical, "エラー"
>    Exit Sub
>  End If
>  
>  Application.ScreenUpdating = False
>  
>  With Sheets("Sheet2")
>    z = .Range("A" & .Rows.Count).End(xlUp).Row + 1
>    If z < 9 Then
>      z = 9
>    Else
>      If z Mod 2 = 0 Then z = z + 1
>    End If
>    With .Rows(z).Resize(2).Columns("A:W")
>      .MergeCells = False   'いったん解除。念のため
>      .Value = Range("A49:W50").Value
>      With .Range("A1:G2,H1:J2,K1:N2,O1:Q2,R1:T1,R2:T2")
>        .VerticalAlignment = xlCenter
>        .Orientation = 0
>        .AddIndent = False
>        .ShrinkToFit = False
>        .ReadingOrder = xlContext
>        Application.DisplayAlerts = False '念のため
>        .Merge
>        Application.DisplayAlerts = True
>      End With
>      .Range("V1:V2").NumberFormatLocal = "yyyy""年""m""月"";@"
>    End With
>    .Select
>  End With
>  
>  Application.ScreenUpdating = True
>  
>  MsgBox "完了", vbOKOnly, "確認"
>End Sub

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