| |
▼やっしー さん：
おはようございます。
>私が思っていたように実行することができました。
>
>ありがとうございました。
>
>それで心苦しいのですが教えていただいたコードの説明を
>
>していただけないでしょうか？
一箇所訂正も含めて
'==========================================================
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を２回実行して１次元配列に格納しています
' funcarrayとなっていましたね 訂正して下さい
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
' 行の各列を列番号の大きい方から列番号が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
以上です。
|
|
ichinose
- 04/12/1(水) 7:43 -
