Excel VBA質問箱 IV

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

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


18712 / 76732 ←次へ | 前へ→

【63458】Re:列の順番を変える方法
回答  Hirofumi  - 09/11/6(金) 13:40 -

引用なし
パスワード
   Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim j As Long
  Dim lngRows As Long
  Dim lngColumns As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim vntKeys As Variant
  Dim strProm As String

  '項目の頭文字を並べる順番に列挙(空白以外は*を付けて)
  vntKeys = Array("N*", "品*", "S*", "", "数*")

  With ActiveSheet.UsedRange
    If .Columns.Count = 1 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    'Listの先頭セル位置を基準とする(先頭列の列見出しのセル位置)
    Set rngList = .Item(1, 1)
    '列数取得
    lngColumns = .Columns.Count
    If lngColumns < UBound(vntKeys) + 1 Then
      lngColumns = UBound(vntKeys) + 1
    End If
    '行数取得
    lngRows = .Rows.Count - 1
  End With
  
  '列見出しを配列に取得
  vntData = rngList.Resize(, lngColumns + 1).Value
  '項目の順位を取得
  For i = 1 To lngColumns
    For j = 0 To UBound(vntKeys)
      If vntData(1, i) Like vntKeys(j) Then
        Exit For
      End If
    Next j
    vntData(1, i) = j
  Next i
    
  '画面更新を停止
  Application.ScreenUpdating = False
  
  With rngList
    'データ最終行の下に順位Keyを出力
    .Offset(lngRows + 1).Resize(, lngColumns).Value = vntData
    '順位順に整列
    DataSort rngList.Resize(lngRows + 2, lngColumns), _
      .Offset(lngRows + 1), xlAscending, xlLeftToRight
    '順位Keyを削除
    .Offset(lngRows + 1).EntireRow.Delete
  End With
    
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

Private Sub DataSort(rngScope As Range, _
          rngKey As Range, _
          Optional lngSortOrder As Long = xlAscending, _
          Optional lngOrientation As Long = xlTopToBottom)

  rngScope.Sort _
      Key1:=rngKey, Order1:=lngSortOrder, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=lngOrientation, SortMethod:=xlStroke

End Sub

7 hits

【63455】列の順番を変える方法 まい 09/11/6(金) 8:43 質問
【63456】Re:列の順番を変える方法 かみちゃん 09/11/6(金) 8:55 発言
【63463】Re:列の順番を変える方法 まい 09/11/9(月) 9:39 お礼
【63457】Re:列の順番を変える方法 SS 09/11/6(金) 9:18 発言
【63462】Re:列の順番を変える方法 まい 09/11/9(月) 9:38 お礼
【63458】Re:列の順番を変える方法 Hirofumi 09/11/6(金) 13:40 回答
【63459】Re:列の順番を変える方法 Hirofumi 09/11/6(金) 13:45 回答
【63461】Re:列の順番を変える方法 まい 09/11/9(月) 9:36 お礼
【63466】Re:列の順番を変える方法 Hirofumi 09/11/9(月) 10:47 発言

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