Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
列を順番通りに入れ替える
投稿日時: 19/12/10 15:22:08
投稿者: chokobanana

データの列を別シートに入力した順番に左から順に並べかえたいです。
ネットで検索して近いものを見つけましたがどこを修正したらいいのか教えてくれませんか?
 
シート「仕様書」の3行目に見出し、B4から下に順番が1.2.3...とあります。
C4から下に会社名があります。
最終行はその時々で変わります。
 
表はC列から、その時々で列数は変わります。
 
【仕様書】
 
   B    C
1
2
3  a@  会社名
4 1    鹿児島
5 2    愛媛
6 3    京都
7 4    長野
8 5    北海道
 
【表】
  
これを
 
  C    D    E   F     G   
1 北海道  愛媛  京都  鹿児島  長野  
 
このように列を入れ替えたいです。
 
  C    D    E   F     G   
1 鹿児島  愛媛  京都  長野   北海道  
 
 
【参考にしているコード】
 
Sub 列順番を入れ替える()
 
 Dim fld As Variant
 Dim rng As Range
 Dim c As Integer
  
 Sheets("Sheet2").Cells.Clear
 c = 1
 For Each fld In Array("商品名", "売上高", "単価", "補足", "補足2")
Set rng = Rows(1).Find(fld, LookAt:=xlWhole)
 
If rng Is Nothing Then
MsgBox fld & " がありません"
Exit Sub
 
Else
 
rng.EntireColumn.Copy Sheets("Sheet2").Cells(1, c)
c = c + 1
 
End If
 
 Next
  
 End Sub
 
 
 
 

回答
投稿日時: 19/12/10 19:51:44
投稿者: WinArrow
投稿者のウェブサイトに移動

> For Each fld In Array("商品名", "売上高", "単価", "補足", "補足2")
のような指定をすると、列番号を変更したいときは、コードの変更が必要になります。
 勿論、列の増減に伴い、コードの変更が必要になります。
  
対応策として
「仕様書」シートの空き列(例、D列)にSheet2の列順番を入力します。
 仕様書シートの列番号を使って、
 「表」シートの列をSheet2の列の複写するようにします。
このようにすれば、列のの増減にも、列変更にもコード変更なしに対応可能です。
  
   
Dim 仕様書, Rx As Long
 
    With Sheets("仕様書")
        仕様書 = .Range("A4:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
     
    With Sheets("表")
        For Rx = LBound(仕様書) To UBound(仕様書)
            .Columns(仕様書(Rx, 1)).Copy Destination:=Sheets("Sheet2").Columns(仕様書(Rx, 3))
        Next
    End With
  
こんなコードでいかがでしょう?
  
  

回答
投稿日時: 19/12/10 20:42:01
投稿者: よろずや

表シートの中で直接列順番を入れ替えるとして、こんなんなりました。
 

Option Explicit
Sub 列順番を入れ替える()
    Const TopRow = 4    '仕様書
    Const LeftCol = 3   '表
    Dim EndRow As Long, c As Long, Row As Long, fld As String, rng As Range
    EndRow = Worksheets("仕様書").Cells(Rows.Count, "C").End(xlUp).Row
    c = LeftCol
    For Row = TopRow To EndRow
        fld = Worksheets("仕様書").Cells(Row, "C").Value
        Set rng = Worksheets("表").Rows(1).Find(fld, Lookat:=xlWhole)
        If rng Is Nothing Then
            MsgBox fld & " がありません"
            Exit Sub
        ElseIf c < rng.Column Then
            rng.EntireColumn.Cut
            Worksheets("表").Columns(c).Insert
        End If
        c = c + 1
    Next Row
    Application.CutCopyMode = False
End Sub

投稿日時: 19/12/11 13:08:46
投稿者: chokobanana

 WinArrowさん
 
.Columns(仕様書(Rx, 1)).Copy Destination:=Sheets("Sheet2").Columns(仕様書(Rx, 3))
 
でエラー9 インデックスが有効範囲にありませんとなります。

回答
投稿日時: 19/12/11 14:40:07
投稿者: WinArrow
投稿者のウェブサイトに移動

仕様書シートのレイアウトを
列B〜列Dのつもりで、
列Dに並べる順序を指定するよう説明したのですが
 
コードを
列A〜列C
と取り違えていました。
 
すみません。
 
> With Sheets("仕様書")
> 仕様書 = .Range("A4:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
> End With

    With Sheets("仕様書")
         仕様書 = .Range("B4:D" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
    End With
 
に修正してください。

投稿日時: 19/12/11 15:24:25
投稿者: chokobanana

よろずやさん
 
希望通りに動きました。
コードを理解するのに時間がかかってしまいお礼が遅くなりまして
申し訳ございません。
 
教えて下さり感謝します。

投稿日時: 19/12/11 15:33:11
投稿者: chokobanana

WinArrowさん
 
もう少し教えていただけますでしょうか。
 
.Columns(仕様書(Rx, 1)).Copy Destination:=Sheets("Sheet2").Columns(仕様書(Rx, 3))
 
Columnsは列を指定していると思うのですがColumns(仕様書(Rx, 1))はどこを指定しているの
でしょうか?
 
実はマクロを実行するとD列に入力した列番号と異なる列順になってしまいました。
上記のコードが関係するのかと推測するのですがColumns(仕様書(Rx, 1))が分からなくて
教えてください。

回答
投稿日時: 19/12/11 18:23:08
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
With Sheets("仕様書")
          仕様書 = .Range("B4:D" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
    End With

↑のコードが終了して時点に
ブレークポイントを設定して、一時的に事項を止めて
ローカルウィンドウで
仕様書(2次元配列)を確認してみてください。
 
.Range("B4:D" & .Cells(.Rows.Count, "B").End(xlUp).Row
で、仕様書シートのデータの範囲を指定していますが、
あっていますか?

回答
投稿日時: 19/12/11 22:09:49
投稿者: WinArrow
投稿者のウェブサイトに移動

シート「表」もシート「Sheet2」も列も始まりがC列から
 ということですね・・・
  
こちらでテストしたままのコードをレスしてしまい
申し訳ありません。
  
仕様書シートのデータに入っている数字そのまま・・・つまりA列から
 というコードになっています。
  
 .Columns(仕様書(Rx, 1) + 2)
 
 .Columns(仕様書(Rx, 3) + 2)
 
というように「+2」することで、先頭列をC列にすることができます。
 

投稿日時: 19/12/12 15:12:13
投稿者: chokobanana

WinArrowさん
 
できました。
最後まで教えて頂き感謝します。