Excel VBA質問箱 IV

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

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


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

【43456】for〜next やずや、やずや 06/10/16(月) 18:22 質問[未読]
【43458】Re:for〜next ハチ 06/10/16(月) 18:54 発言[未読]
【43460】Re:for〜next やずや、やずや 06/10/16(月) 19:22 質問[未読]
【43463】Re:for〜next ハチ 06/10/16(月) 20:01 発言[未読]
【43467】Re:for〜next やずや、やずや 06/10/16(月) 20:17 お礼[未読]

【43456】for〜next
質問  やずや、やずや  - 06/10/16(月) 18:22 -

引用なし
パスワード
   業務日報を作っています。
Worksheets("0")からWorksheets("DF2")に指定した日付内から情報を引き出すように作っています。
同じセル番号同士ではうまくいきますが、違うセルに移す方法が分かりません。
煩雑なソースですが、よろしく御願いいたします。


Private Sub CommandButton1_Click()

If UserForm4.ComboBox1 = "" Or UserForm4.ComboBox12 = "" Or UserForm4.ComboBox9 = "" Or _
  UserForm4.ComboBox11 = "" Or UserForm4.ComboBox15 = "" Or UserForm4.ComboBox14 = "" Or _
  UserForm4.ComboBox13 = "" Then

MsgBox "検索範囲が不適切です", vbExclamation

Else


'-------閲覧シートへ-------------------
'範囲の取得

at01 = UserForm4.ComboBox1.ListIndex '業務名

'----------開始日-----------------
at02 = UserForm4.ComboBox12.Text '年度
at03 = UserForm4.ComboBox9.Text '月
at04 = UserForm4.ComboBox11.Text '日


'----------終了日-----------------
at05 = UserForm4.ComboBox15.Text '年度
at06 = UserForm4.ComboBox14.Text '月
at07 = UserForm4.ComboBox13.Text '日

'*****************検索*********************


'----------開始日の行-----------------
For i10 = 1 To 1000
 If Worksheets("0").Cells(i10, 4).Text = at04 And _
   Worksheets("0").Cells(i10, 3).Text = at03 And _
   Worksheets("0").Cells(i10, 2).Text = at02 Then
   at20 = i10
 Exit For
 End If
 Next i10
 
'----------終了日の行-----------------
For i20 = 1 To 1000
 If Worksheets("0").Cells(i20, 4).Text = at07 And _
   Worksheets("0").Cells(i20, 3).Text = at06 And _
   Worksheets("0").Cells(i20, 2).Text = at05 Then
   at30 = i20
 Exit For
 End If
 Next i20
 
 
Worksheets("DF").Range("A11") = at30 '削除用

 
'*****************表示*********************
'--------------------------------------------
at40 = at30 - at20 '行の範囲
 
   For g20 = at20 To at30
    a100 = g20
    a110 = "M" + CStr(a100)
    a111 = "P" + CStr(a100)
    a112 = "A" + CStr(a100)
    a113 = "J" + CStr(a100)
    a114 = "K" + CStr(a100)
    a115 = "R" + CStr(a100)
    a116 = "Q" + CStr(a100)
        
    For g30 = 2 To at40 + 2
     a100 = g30
    a110 = "M" + CStr(a100)
    a111 = "P" + CStr(a100)
    a112 = "A" + CStr(a100)
    a113 = "J" + CStr(a100)
    a114 = "K" + CStr(a100)
    a115 = "R" + CStr(a100)
    a116 = "Q" + CStr(a100)
    
   x1 = Worksheets("0").Range(a110) '業務名
   x2 = Worksheets("0").Range(a111) '工期
   x3 = Worksheets("0").Range(a112) '社員名
   x4 = Worksheets("0").Range(a113) '総時
   x5 = Worksheets("0").Range(a114) '総分
   x6 = Worksheets("0").Range(a115) '人件費
   x7 = Worksheets("0").Range(a116) '契約金額

  Worksheets("DF2").Range(a110) = x1 '業務名
  Worksheets("DF2").Range(a111) = x2 '工期
  Worksheets("DF2").Range(a112) = x3 '社員名
  Worksheets("DF2").Range(a113) = x4 '総時
  Worksheets("DF2").Range(a114) = x5 '総分
  Worksheets("DF2").Range(a115) = x6 '人件費
  Worksheets("DF2").Range(a116) = x7 '契約金額
    
   Next g30
  Exit For
 Next g20
 
MsgBox "表示が完了しました", vbInformation
UserForm4.Label18.Caption = ""

End If
End Sub

【43458】Re:for〜next
発言  ハチ  - 06/10/16(月) 18:54 -

引用なし
パスワード
   ▼やずや、やずや さん:

このあたりから〜

>'--------------------------------------------
>at40 = at30 - at20 '行の範囲
> 
>   For g20 = at20 To at30
>    a100 = g20
>    a110 = "M" + CStr(a100)
>    a111 = "P" + CStr(a100)
>    a112 = "A" + CStr(a100)
>    a113 = "J" + CStr(a100)
>    a114 = "K" + CStr(a100)
>    a115 = "R" + CStr(a100)
>    a116 = "Q" + CStr(a100)
>        
>    For g30 = 2 To at40 + 2
>     a100 = g30
>    a110 = "M" + CStr(a100)
>    a111 = "P" + CStr(a100)
>    a112 = "A" + CStr(a100)
>    a113 = "J" + CStr(a100)
>    a114 = "K" + CStr(a100)
>    a115 = "R" + CStr(a100)
>    a116 = "Q" + CStr(a100)
>    
>   x1 = Worksheets("0").Range(a110) '業務名
>   x2 = Worksheets("0").Range(a111) '工期
>   x3 = Worksheets("0").Range(a112) '社員名
>   x4 = Worksheets("0").Range(a113) '総時
>   x5 = Worksheets("0").Range(a114) '総分
>   x6 = Worksheets("0").Range(a115) '人件費
>   x7 = Worksheets("0").Range(a116) '契約金額
>
>  Worksheets("DF2").Range(a110) = x1 '業務名
>  Worksheets("DF2").Range(a111) = x2 '工期
>  Worksheets("DF2").Range(a112) = x3 '社員名
>  Worksheets("DF2").Range(a113) = x4 '総時
>  Worksheets("DF2").Range(a114) = x5 '総分
>  Worksheets("DF2").Range(a115) = x6 '人件費
>  Worksheets("DF2").Range(a116) = x7 '契約金額
>    
>   Next g30
>  Exit For
> Next g20

〜このあたりまでのことですか?
どうしたいのか良くわかりません。
ループはなにを意味しているのでしょうか?

【43460】Re:for〜next
質問  やずや、やずや  - 06/10/16(月) 19:22 -

引用なし
パスワード
   >〜このあたりまでのことですか?
>どうしたいのか良くわかりません。
>ループはなにを意味しているのでしょうか?


大変はずかしいのですが、あれこれコードを作っていたらうまくいった・・というコードです。別のシートへ指定した範囲内のデータを同じセル名の場所へコピーします。自分自身でもこのコードの動きを完全には把握できてないのですが・・

このコードだと、別のシートの「同じセル位置」にしかデータをコピーできません。これを、任意の位置に並び替えてコピーしたいです。
コード自体がダメでしょうか?
ご教授、よろしく御願いいたします。

【43463】Re:for〜next
発言  ハチ  - 06/10/16(月) 20:01 -

引用なし
パスワード
   ▼やずや、やずや さん:

見当違いかもしれませんが・・・

新しいBookを作成して
1枚目のA1〜E1までにテキトー文字を入れてみて
下のコードを実行してみてください。
2枚目に並び替わってコピーされますが
こんな感じですか?
「A列、B列」ではなく「1列,2列」で考えたほうが良いと思います。

サンプルではセル単位ですが応用すれば、
指定した範囲の列単位で並び替えてコピーすることもできます。

Option Explicit
Sub Test()
  Dim c1 As Integer, c2 As Integer
  
  For c1 = 1 To 5
    '1,2,3列を3,2,1と並び替え。残り4,5はそのまま
    Select Case c1
      Case 1: c2 = 3
      Case 2: c2 = 2
      Case 3: c2 = 1
      Case Else: c2 = c1
    End Select
    Worksheets(2).Cells(1, c2).Value = Worksheets(1).Cells(1, c1).Value
  Next c1
End Sub

【43467】Re:for〜next
お礼  やずや、やずや  - 06/10/16(月) 20:17 -

引用なし
パスワード
   ▼ハチ さん:

ありがとうございます。
うまくいきそうです。
研究してみます。

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