Excel VBA質問箱 IV

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

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


61171 / 76738 ←次へ | 前へ→

【20192】Re:並べ替え
発言  ichinose  - 04/12/1(水) 7:43 -

引用なし
パスワード
   ▼やっしー さん:
おはようございます。
>私が思っていたように実行することができました。
>
>ありがとうございました。
>
>それで心苦しいのですが教えていただいたコードの説明を
>
>していただけないでしょうか?
一箇所訂正も含めて
'==========================================================
Sub main()
  Dim fundarray() As Variant
' 一行目のセルの値を格納する配列
  On Error Resume Next
  With Application
   fundarray() = .Transpose(.Transpose(Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft)).Value))
'  一行目のセルの値を格納する Match関数で使用したいので
'  Transposeを2回実行して1次元配列に格納しています
'  funcarrayとなっていましたね 訂正して下さい
   End With
  For idx = 2 To ActiveSheet.UsedRange.Resize(, 1).Rows.Count
'   2行目から使用されている行までのリピート処理
   For jdx = Cells(idx, Columns.Count).End(xlToLeft).Column To 1 Step -1
'    行の各列を列番号の大きい方から列番号が1になるまでのリピート処理
     Err.Clear 'エラークリア
     f_val = Trim(Split(Cells(idx, jdx).Value, "=")(0))
'    セルのデータを"="で分割した最初のデータをf_valに格納
'    この際、セルが未入力の場合、エラーが発生するので
     If Err.Number = 0 Then 'セルの値が未入力でなければ
      wk = Application.Match(f_val, fundarray(), 0)
'      一行目のセルの値を格納した配列内をf_valで検索あれば、
'        wkには列番号に相当する値が返る
'      ここも funcarrayとなっていましたね 訂正して下さい
      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

以上です。

0 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 お礼

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