Excel VBA質問箱 IV

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

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


61195 / 76732 ←次へ | 前へ→

【20161】Re:並べ替え
回答  ichinose  - 04/11/30(火) 8:20 -

引用なし
パスワード
   やっしー さん、kazu さん、おはようございます。

>1行目には、Q1, Q2_1, Q2_2, Q3, などのQを付与した数字を順においています。
>
>2行目以降には「Q1 =2」「Q3 =2」「Q2_1=3」「Q2_2=4」などがバラバラに並んでいます。
>ちなみに「Q1」「Q3」のイコール(=)はスペースをあけて「Q2_1」のイコールに揃えています。
>
>2行目以降のバラバラに並んでいる「Q1 =3」「Q1 =2」「Q2_1=1」をそれぞれイコールの前がQ1ならQ1で、Q2_1ならQ2_1に、列ごとに整列させたいのです。
>
>もちろん1行目の Q1, Q2_1, Q2_2, Q3 に揃えて。
>
>★行目は、Q1 =2, Q2_1=3, Q2_2=4, Q3 =2
>●行目は、Q1 =3, Q2_2=3, Q3 =1
>
>というふうになっているので
>
>例えば●行目のとき、「Q2_2=3」を横方向に一つのセルを飛ばして、1行目のQ2_2と書かれている列に移動し、Q3と書かれている列にQ3もまた、ひとつ横にセルをずらしたい。
1行目のデータとそれ以降の行の各列の「=」で区切られた左側の文字列を比較する
と言う意味で解釈しました。

'===============================================================
Sub main()
  Dim fundarray() As Variant
  On Error Resume Next
  With Application
   funcarray = .Transpose(.Transpose(Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft)).Value))
   End With
  For idx = 2 To ActiveSheet.UsedRange.Resize(, 1).Rows.Count
   For jdx = Cells(idx, Columns.Count).End(xlToLeft).Column To 1 Step -1
     Err.Clear
     f_val = Trim(Split(Cells(idx, jdx).Value, "=")(0))
     If Err.Number = 0 Then
      wk = Application.Match(f_val, funcarray, 0)
      If Not IsError(wk) Then
        tmp = Cells(idx, jdx).Value
        Cells(idx, jdx).Value = ""
        Cells(idx, wk).Value = tmp
        End If
      End If
     Next jdx
   Next idx
End Sub

簡単なテストをした限りでは、作動しています。
確認してみて下さい。
1 hits

【20123】並べ替え やっしー 04/11/29(月) 1:12 質問
【20132】Re:並べ替え kazu 04/11/29(月) 14:19 発言
【20159】Re:並べ替え やっしー 04/11/30(火) 3:27 お礼
【20160】Re:並べ替え やっしー 04/11/30(火) 3:32 質問
【20161】Re:並べ替え ichinose 04/11/30(火) 8:20 回答
【20165】Re:並べ替え kazu 04/11/30(火) 10:19 発言
【20189】Re:並べ替え やっしー 04/12/1(水) 2:11 お礼
【20190】Re:並べ替え やっしー 04/12/1(水) 3:14 質問
【20192】Re:並べ替え ichinose 04/12/1(水) 7:43 発言
【20203】Re:並べ替え やっしー 04/12/1(水) 13:08 お礼

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