Excel VBA質問箱 IV

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

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


2272 / 13645 ツリー ←次へ | 前へ→

【69008】並び順が不規則なデータを整列する 武藤 晃作 11/5/7(土) 21:00 質問[未読]
【69009】Re:並び順が不規則なデータを整列する UO3 11/5/7(土) 21:08 発言[未読]
【69023】Re:並び順が不規則なデータを整列する 武藤 晃作 11/5/10(火) 22:01 質問[未読]
【69024】Re:並び順が不規則なデータを整列する UO3 11/5/10(火) 23:04 回答[未読]
【69038】Re:並び順が不規則なデータを整列する 武藤 晃作 11/5/11(水) 22:00 お礼[未読]

【69008】並び順が不規則なデータを整列する
質問  武藤 晃作  - 11/5/7(土) 21:00 -

引用なし
パスワード
   大学で教鞭をとっている者です.
学生に1枚ずつレポートとしてExcelブックを提出してもらいました.
ただ,列ごとに記載されている項目(変数と言うのでしょうか)が
A B C D E
のように並んでいるブックもあれば
B A C E D

C E A D B
のように並んでいるブックもあります.
特に注目すべきはAとCなので,すべてのExcelブックに新規シートを追加して
A Cだけのデータ,しかも並び順はA CでB〜Eは削るように設定したいのですが
VBAで実行することはできるものでしょうか.

【69009】Re:並び順が不規則なデータを整列する
発言  UO3  - 11/5/7(土) 21:08 -

引用なし
パスワード
   ▼武藤 晃作 さん:

こんばんは

その、まちまちの列の、どれがAで、どれがCというのは判別できる状態でしょうか?
たとえば全員のブックの見出し項目名が同じとか。
あるいは、見出し項目の中に、○○という文字があればA列、□□という文字があればC列とか。
そうであればVBA処理はできますが、そうじゃなければ、ブックごとに、どれがA列で
どれがC列かを指定しながら処理を行うということになります。

【69023】Re:並び順が不規則なデータを整列する
質問  武藤 晃作  - 11/5/10(火) 22:01 -

引用なし
パスワード
   ▼UO3 さん:
>その、まちまちの列の、どれがAで、どれがCというのは判別できる状態でしょうか?
>たとえば全員のブックの見出し項目名が同じとか。

1行目に全員同じ見出し項目を入れさせております.
よろしくお願いします.

【69024】Re:並び順が不規則なデータを整列する
回答  UO3  - 11/5/10(火) 23:04 -

引用なし
パスワード
   ▼武藤 晃作 さん:

・まず、フォルダを1つ(任意の場所に)作成して、学生さんのブックを
 すべて、そこに保存してください。
・新規ブックの標準モジュールに以下を貼り付けてください。
 A列、C列の見出し語は実際のものに変更してください。
 また、学生さんのブック、処理後も閉じずにエクセル上に残していますが
 処理後は自動的に閉じたほうがよければ、コメントアウトしたクローズ命令を
 いかしてください。
・で、このマクロブックを任意の名前で上で作ったフォルダに保存した上で実行してください。

Sub Sample()
  Dim myPath As String
  Dim myBook As String
  Dim TitleA As String
  Dim TitleC As String
  Dim colA As Variant, colC As Variant
  
  Application.ScreenUpdating = False
  
  myPath = ThisWorkbook.Path
  TitleA = "項目A" '実際の見出し名にしてください。
  TitleC = "項目C" '実際の見出し名にしてください
  myBook = Dir(myPath & "\*.xls")
  
  Do While myBook <> ""
    If myBook <> ThisWorkbook.Name Then
      Workbooks.Open myPath & "\" & myBook
      With Worksheets(1)
        colA = Application.Match(TitleA, .Rows(1), 0)
        colC = Application.Match(TitleC, .Rows(1), 0)
        
        If Not IsNumeric(colA) Or Not IsNumeric(colC) Then
          MsgBox ActiveWorkbook.Name & "には所定の見出しがありません" & vbLf & _
              "処理をスキップします"
          ActiveWorkbook.Close savechanges:=False
        Else
          Sheets.Add after:=Sheets(Worksheets.Count)
          .Columns(colA).Copy Destination:=Range("A1")
          .Columns(colC).Copy Destination:=Range("B1")
          Application.CutCopyMode = False
          Application.DisplayAlerts = False
          
          'ActiveWorkbook.Close True  '必要ならこのコードを実行
          
          Application.DisplayAlerts = True
        End If
      End With
    End If
    myBook = Dir()
  Loop
  
  Application.ScreenUpdating = True
  
End Sub

【69038】Re:並び順が不規則なデータを整列する
お礼  武藤 晃作  - 11/5/11(水) 22:00 -

引用なし
パスワード
   ▼UO3 さん:

おかげさまでうまくいきました.
ありがとうございました.
これからは楽できそうです.

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