Excel VBA質問箱 IV

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

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


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

【73576】並べ替えについて マリモ 13/1/23(水) 15:56 質問[未読]
【73580】Re:並べ替えについて ウッシ 13/1/24(木) 12:10 回答[未読]
【73583】Re:並べ替えについて マリモ 13/1/24(木) 12:43 お礼[未読]
【73582】Re:並べ替えについて kanabun 13/1/24(木) 12:42 発言[未読]
【73584】Re:並べ替えについて マリモ 13/1/24(木) 13:09 お礼[未読]
【73585】Re:並べ替えについて マリモ 13/1/24(木) 13:17 質問[未読]
【73586】Re:並べ替えについて kanabun 13/1/24(木) 13:25 発言[未読]
【73587】Re:並べ替えについて kanabun 13/1/24(木) 13:43 発言[未読]
【73591】Re:並べ替えについて マリモ 13/1/24(木) 14:40 お礼[未読]
【73588】Re:並べ替えについて ウッシ 13/1/24(木) 13:56 回答[未読]
【73590】Re:並べ替えについて マリモ 13/1/24(木) 14:39 お礼[未読]

【73576】並べ替えについて
質問  マリモ  - 13/1/23(水) 15:56 -

引用なし
パスワード
   こんにちは。お世話になっております。
量が多くて申し訳ありませんが
宜しくお願いいたします。

まず、Sheet1の1行目を削除します。
(2行ずつ1セットになっています。)
Q列の1桁目を削除します。(例:3500→350)
Sheet1E1→Sheet2B1
Sheet1M1→Sheet2H1
Sheet1G1(例:20110102)→Sheet2I1(23),Sheet2J1(1),Sheet2K1(2)
Sheet1J1→Sheet2L1
Sheet1L1→Sheet2N1
Sheet1H1→Sheet2O1
Sheet1K1→Sheet2P1
Sheet1R1→Sheet2Q1
Sheet1AB1→Sheet2R1
Sheet1V1→Sheet2T1
Sheet1X1→Sheet2V1
Sheet1O1→Sheet2Z1
Sheet1Q1→Sheet2AA1
Sheet1Z1→Sheet2AB1
Sheet1AF1→Sheet2AN1
Sheet1AF2→Sheet2AO1
Sheet1AL1→Sheet2BI1
Sheet1AN1→Sheet2BH1

Sheet1E3→Sheet2B2
Sheet1M3→Sheet2H2
Sheet1G3→Sheet2I2,Sheet2J2,Sheet2K2
Sheet1J3→Sheet2L2
Sheet1L3→Sheet2N2
Sheet1H3→Sheet2O2
Sheet1K3→Sheet2P2
Sheet1R3→Sheet2Q2
Sheet1AB3→Sheet2R2
Sheet1V3→Sheet2T2
Sheet1X3→Sheet2V2
Sheet1O3→Sheet2Z2
Sheet1Q3→Sheet2AA2
Sheet1Z3→Sheet2AB2
Sheet1AF3→Sheet2AN2
Sheet1AF4→Sheet2AO2
Sheet1AL3→Sheet2BI2
Sheet1AN3→Sheet2BH2

上記のパターンを繰り返し、
最後にSheet2R列が1〜14の場合は1を入力、21〜30の場合は2を入力、
それ以外は3をSheet2S列に入力します。

【73580】Re:並べ替えについて
回答  ウッシ  - 13/1/24(木) 12:10 -

引用なし
パスワード
   こんにちは

全部書く気にはならないので足りない分は追加して下さい。

Sub test()
  Dim i As Long
  Dim j As Long
  Dim r As Long
  Dim s As Range
  
  Application.ScreenUpdating = False
  With Worksheets("Sheet1")
    .Rows(1).Delete
    j = .Range("E" & Rows.Count).End(xlUp).Row
    
    For Each s In Range("Q1:Q" & j)
      If Not IsEmpty(s.Value) Then
        s.Value = Left(s.Value, Len(s.Value) - 1)
      End If
    Next
    j = j / 2
    
    For i = 1 To j
      r = i * 2 - 1
      .Range("E" & r).Copy Worksheets("Sheet2").Range("B" & i)
      
      Worksheets("Sheet2").Range("I" & i).Value = _
        Format(Left(.Range("G" & r), 4) & "/1/1", "e")
      Worksheets("Sheet2").Range("J" & i).Value = _
        Mid(.Range("G" & r), 5, 2)
      Worksheets("Sheet2").Range("K" & i).Value = _
        Right(.Range("G" & r), 2)
      .Range("Q" & r).Copy Worksheets("Sheet2").Range("AA" & i)
      
      .Range("AB" & r).Copy Worksheets("Sheet2").Range("R" & i)
      
      Select Case Worksheets("Sheet2").Range("R" & i).Value
        Case 1 To 14: Worksheets("Sheet2").Range("S" & i).Value = 1
        Case 21 To 30: Worksheets("Sheet2").Range("S" & i).Value = 2
        Case Else: Worksheets("Sheet2").Range("S" & i).Value = 3
      End Select
    Next
  End With
  Application.ScreenUpdating = True
End Sub

【73582】Re:並べ替えについて
発言  kanabun  - 13/1/24(木) 12:42 -

引用なし
パスワード
   ▼マリモ さん:

>まず、Sheet1の1行目を削除します。
>(2行ずつ1セットになっています。)
>Q列の1桁目を削除します。(例:3500→350)
はできているものとして、、、
これ以降、
>Sheet1E1→Sheet2B1
>Sheet1M1→Sheet2H1
>Sheet1G1(例:20110102)→Sheet2I1(23),Sheet2J1(1),Sheet2K1(2)
>Sheet1J1→Sheet2L1
>Sheet1L1→Sheet2N1
>Sheet1H1→Sheet2O1
>Sheet1K1→Sheet2P1
>Sheet1R1→Sheet2Q1
>Sheet1AB1→Sheet2R1
>Sheet1V1→Sheet2T1
>Sheet1X1→Sheet2V1
>Sheet1O1→Sheet2Z1
>Sheet1Q1→Sheet2AA1
>Sheet1Z1→Sheet2AB1
>Sheet1AF1→Sheet2AN1
>Sheet1AF2→Sheet2AO1
>Sheet1AL1→Sheet2BI1
>Sheet1AN1→Sheet2BH1

の繰り返し部分は こう書けます。
参考にしてください。

Sub Try1()
 Dim c As Range, r As Range, rr As Range
 Dim yy As Long
 Dim ss As String
 Const BH = 60
 
 With Worksheets("Sheet1")
   yy = .Cells(.Rows.Count, "AF").End(xlUp).Row
   Set c = .Range("A1")
 End With
 With Worksheets("Sheet2")
   Set rr = .Range("A1").Resize(yy \ 2, BH)
 End With
 For Each r In rr.Columns(1).Cells
   r.Range("B1") = c.Range("E1")
   r.Range("H1") = c.Range("M1")
   ss = c.Range("G1").Value   '(例:20110102)
   r.Range("I1") = Left$(ss, 4) '-----
   r.Range("J1") = Mid$(ss, 5, 2)
   r.Range("K1") = Mid$(ss, 7) '-----
   r.Range("L1") = c.Range("J1")
   r.Range("N1") = c.Range("L1")
   r.Range("O1") = c.Range("H1")
   r.Range("P1") = c.Range("K1")
   r.Range("Q1") = c.Range("R1")
   r.Range("R1") = c.Range("AB1")
   r.Range("T1") = c.Range("V1")
   r.Range("V1") = c.Range("X1")
   r.Range("Z1") = c.Range("O1")
   r.Range("AA1") = c.Range("Q1")
   r.Range("AB1") = c.Range("Z1")
   r.Range("AN1") = c.Range("AF1")
   r.Range("AO1") = c.Range("AF2")
   r.Range("BI1") = c.Range("AL1")
   r.Range("BH1") = c.Range("AN1")
   Set c = c.Offset(2)
 Next
End Sub

このアドレスは相対アドレスで、
たとえば Sheet1 の [B10] セルは
c が Sheet1 の[A9] であれば

  c.Range("B2")

と書けることを
利用しています。

【73583】Re:並べ替えについて
お礼  マリモ  - 13/1/24(木) 12:43 -

引用なし
パスワード
   ▼ウッシ さん:

知りたいところの要点をすべて解決してくださり、
ありがとうございました。

次回、質問させていただくことがありましたら、
要点だけに絞りたいと思います。

【73584】Re:並べ替えについて
お礼  マリモ  - 13/1/24(木) 13:09 -

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

ありがとうございます。
参考にさせていただきます。

【73585】Re:並べ替えについて
質問  マリモ  - 13/1/24(木) 13:17 -

引用なし
パスワード
   >Sheet1AF1→Sheet2AN1
>Sheet1AF2→Sheet2AO1

度々、すみません。
ここの部分なのですが、1列を2列にしたいです。
AF列をAN列とAO列に交互に入れたいのですが、
いい方法がありましたら、教えていただきたいです。

【73586】Re:並べ替えについて
発言  kanabun  - 13/1/24(木) 13:25 -

引用なし
パスワード
   ▼マリモ さん:
>>Sheet1AF1→Sheet2AN1
>>Sheet1AF2→Sheet2AO1
>
>度々、すみません。
>ここの部分なのですが、1列を2列にしたいです。
>AF列をAN列とAO列に交互に入れたいのですが、

>   r.Range("AN1") = c.Range("AF1")
>   r.Range("AO1") = c.Range("AF2")

ということじゃなくて?

【73587】Re:並べ替えについて
発言  kanabun  - 13/1/24(木) 13:43 -

引用なし
パスワード
   こうしたいんじゃないかと思ったのですが、ちがいましたか?

[Sheet2]
 B H IJK L N O P Q R  T  V  Z AA BB AN AO
1 E1 M1 (日付) J1 L1 H1 K1 R1 AB1  V1  X1  O1 Q1 Z1 AF1 AF2
2 E3 M3 (日付) J3 L3 H3 K3 R3 AB3  V3  X3  O3 Q3 Z3 AF3 AF4
3 E5 M5 (日付) J5 L5 H5 K5 R5 AB5  V5  X5  O5 Q5 Z5 AF5 AF6
:
:

セル内の値は Sheet1のコピー元のアドレスです。

【73588】Re:並べ替えについて
回答  ウッシ  - 13/1/24(木) 13:56 -

引用なし
パスワード
   こんにちは

      .Range("AF" & r).Copy Worksheets("Sheet2").Range("AN" & i)
      .Range("AF" & r + 1).Copy Worksheets("Sheet2").Range("AO" & i)

とは違いますか?


▼マリモ さん:
>>Sheet1AF1→Sheet2AN1
>>Sheet1AF2→Sheet2AO1
>
>度々、すみません。
>ここの部分なのですが、1列を2列にしたいです。
>AF列をAN列とAO列に交互に入れたいのですが、
>いい方法がありましたら、教えていただきたいです。

【73590】Re:並べ替えについて
お礼  マリモ  - 13/1/24(木) 14:39 -

引用なし
パスワード
   ▼ウッシ さん:

解決しました。
盛り沢山の内容を全部教えて下さり
感謝しております。
ありがとうございました。

【73591】Re:並べ替えについて
お礼  マリモ  - 13/1/24(木) 14:40 -

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

>こうしたいんじゃないかと思ったのですが、ちがいましたか?

その通りです。
おかげさまで無事解決できました。
ありがとうございました。

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