Excel VBA質問箱 IV

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

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


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

【72905】表を並べ替えたい ぶらっと 12/10/5(金) 13:11 質問[未読]
【72906】Re:表を並べ替えたい ウッシ 12/10/5(金) 14:22 質問[未読]
【72907】Re:表を並べ替えたい ぶらっと 12/10/5(金) 14:43 発言[未読]
【72908】Re:表を並べ替えたい ウッシ 12/10/5(金) 15:34 回答[未読]
【72914】Re:表を並べ替えたい ぶらっと 12/10/5(金) 17:46 お礼[未読]
【72916】Re:表を並べ替えたい ウッシ 12/10/5(金) 23:27 発言[未読]

【72905】表を並べ替えたい
質問  ぶらっと  - 12/10/5(金) 13:11 -

引用なし
パスワード
   このような表があります。
あ1 あ2 あ3 あ4・・・
い1 い2 い3 い4




このように並べ替えたい
あ1 あ3・・・
あ2 あ4
い1 い3
い2 い4



それぞれのセルには式が入っているので、その式はそのまま維持したいです。
最初に表の1行を選んでおいて、処理するデータの最初と最後を指定する。
あ1 あ2 あ3 あ4・・あ9
ーーーーーーーーーーーーーーーー
(あ1からあ9まで選んでおく)

縦方向は、あ1の列のデータがある1番下までとしたいです。

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

【72906】Re:表を並べ替えたい
質問  ウッシ  - 12/10/5(金) 14:22 -

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

あ1  あ2  あ3  あ4  あ5  あ6  あ7  あ8  あ9
い1  い2  い3  い4  い5  い6  い7  い8  い9

>あ1からあ9まで選んでおいて
>縦方向は、あ1の列のデータがある1番下まで

並べ替えたら、どうなって欲しいのですか?

【72907】Re:表を並べ替えたい
発言  ぶらっと  - 12/10/5(金) 14:43 -

引用なし
パスワード
   ▼ウッシ さん ありがとうございます。

あ1  あ3  あ5  あ7  あ9
あ2 あ4  あ6 あ8
い1  い3  い5  い7  い9
い2 い4  い6 い8
こうしたいのです。

【72908】Re:表を並べ替えたい
回答  ウッシ  - 12/10/5(金) 15:34 -

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

選択したセルのデータを消して並べ替えたデータ書き込みますのでバックアップをとっておいて下さい。

Sub test()
  Dim s  As Range
  Dim i  As Long
  Dim j  As Long
  Dim ii As Long
  Dim jj As Long
  Dim r  As Long
  Dim c  As Long
  Dim d()
  On Error Resume Next
  Set s = Selection
  If s Is Nothing Then Exit Sub
  On Error Resume Next
  With s
    i = .Cells.Count
    If .Rows.Count <> 1 Then Exit Sub
    If .Row <> 1 Then Exit Sub
    If i < 2 Then Exit Sub
    With .Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
    End With
    With WorksheetFunction
      j = .CountA(s.Cells(1, 1).EntireColumn)
      ReDim d(1 To j * 2, 1 To .RoundUp(i / 2, 0))
    End With
    For jj = 1 To j
      r = jj * 2 - 1
      For ii = 1 To i Step 2
        c = (ii + 1) / 2
        d(r, c) = s(jj, ii).Formula
        If ii + 1 < i Then
          d(r + 1, c) = s(jj, ii + 1).Formula
        End If
      Next
    Next
    .EntireColumn.ClearContents
    .Resize(UBound(d, 1), UBound(d, 2)).Value = d
    With .Application
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
    End With
  End With
End Sub

【72914】Re:表を並べ替えたい
お礼  ぶらっと  - 12/10/5(金) 17:46 -

引用なし
パスワード
   ▼ウッシ さん 回答ありがとうございます。
まったく動かなかったので、下記を訂正してうまくいきました。


>  With s
>    i = .Cells.Count
>    If .Rows.Count <> 1 Then Exit Sub
>    If .Row <> 1 Then Exit Sub ←削除

【72916】Re:表を並べ替えたい
発言  ウッシ  - 12/10/5(金) 23:27 -

引用なし
パスワード
   ▼ぶらっと さん:
>▼ウッシ さん 回答ありがとうございます。
>まったく動かなかったので、下記を訂正してうまくいきました。
>
>
>>  With s
>>    i = .Cells.Count
>>    If .Rows.Count <> 1 Then Exit Sub
>>    If .Row <> 1 Then Exit Sub ←削除

データは1行目からじゃ無かったんですね。

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