ここから本文です

エクセル詳しい方!1列に並ぶセルを同じ項目は列のままで、横並びにしたい。 画...

pur********さん

2019/5/1409:16:38

エクセル詳しい方!1列に並ぶセルを同じ項目は列のままで、横並びにしたい。
画像のようなものが何千行も続くので、一括で対応したいです。よろしくお願いします。

補足すみません、画像がわかりにくかったですね。。

〇変更前

A B C D E F
青森県 アオモリケン 弘前市 ヒロサキシ 豊里町山根前 ハマノマチヒガシ
青森県 アオモリケン 弘前市 ヒロサキシ 豊里町横町 ハラガタイ
青森県 アオモリケン 弘前市 ヒロサキシ 登米町小島 ハラガタイ
青森県 アオモリケン 平川市 ヒラカワシ 沢上山 コスギオウギダ
青森県 アオモリケン 平川市 ヒラカワシ 仕切目 コスギカワサキ
青森県 アオモリケン 平川市 ヒラカワシ 島木野 コスギタケウチ
山形県 ヤマガタケン 山形市 ヤマガタシ 小八木町 ドウマチ
山形県 ヤマガタケン 山形市 ヤマガタシ 佐野窪町 ドウヤグチ

〇変更後
A B C D E F
青森県 アオモリケン 山形県 ヤマガタケン
弘前市 ヒロサキシ 平川市 ヒラカワシ 山形市 ヤマガタシ
豊里町山根前 ハマノマチヒガシ 沢上山 コスギオウギダ … …
豊里町横町 ハラガタイ 仕切目 コスギカワサキ
登米町小島 ハラガタイ 島木野 コスギタケウチ

分かりづらくて申し訳ないのですが、
上記のように表示を変更したいです。
県はさいあく対応していなくても大丈夫です。
(変更後の列は無視いただいて結構です。)

よろしくお願いします。

Dim i As Long,千行,With r.Resize,Option Explicit,1 To UBound,Rows.Count,横並び

閲覧数:
111
回答数:
3

違反報告

ベストアンサーに選ばれた回答

kik********さん

2019/5/1415:25:36

VBA で良かったですか?ダメならスルーということで

補足あったようですが、提示されていた画像の内容とチョッと違うような??

画像をベースにした処理になれば・・・
以下の確認手順ですが、

・新規ブックを開きます
・Alt + F11 で、VBE 画面を表示します
・メニュー 挿入→標準モジュール 後、表示された真っ白なところへ、
以下の Option Explicit 以下全部を張り付け
・Alt + F11 でシート側に戻り、Alt + F8 でマクロ画面を表示後、
testData を実行し、行数を入力すると、それらしいデータが表示されます
・Alt + F8 で、Samp1 を選んで実行

もしくは、testData 実行後、Samp2 を実行してみる

Samp1 は、配列を使った、速いかな?処理で
Samp2 は、遅くなるけど、Excel ッポイ処理してみた

やっていることは、
C 列を基準に、同じ内容が続く範囲で、列分割していく

どうなりますか


Option Explicit

Public Sub Samp1()
   Dim vA As Variant, vR As Variant
   Dim r As Range
   Dim i As Long, j As Long, k As Long, n As Long

   Set r = Range("H1") ' 書出し位置

   With Range("C1", Cells(Rows.Count, "C").End(xlUp))
      vA = .Resize(, 4).Value
   End With

   Application.ScreenUpdating = False
   i = 1
   While (i <= UBound(vA))
      For j = i + 1 To UBound(vA)
         If (vA(j, 1) <> vA(i, 1)) Then Exit For
      Next
      n = j - i
      ReDim vR(0 To n, 1 To 2)
      vR(0, 1) = vA(i, 1)
      vR(0, 2) = vA(i, 2)
      For k = 1 To n
         vR(k, 1) = vA(i + k - 1, 3)
         vR(k, 2) = vA(i + k - 1, 4)
      Next
      i = j

      With r.Resize(n + 1, 2)
         .Value = vR
         .BorderAround xlContinuous
         .EntireColumn.AutoFit
      End With
      Set r = r.Offset(, 2)
   Wend
   Application.ScreenUpdating = True
End Sub


' 確認用データ作成

Public Sub testData()
   Dim vA As Variant
   Dim sS As String
   Dim i As Long, j As Long, k As Long, n As Long, m As Long

   Randomize

   sS = InputBox("何行?", , 1000)
   If (sS = "") Then Exit Sub
   n = Val(sS)
   If (n < 1) Then n = 3

   ReDim vA(1 To n, 1 To 6)

   m = 0: k = 0
   For i = 1 To n
      If (k <= 0) Then
         m = m + 1
         k = Int(20 * Rnd()) + 1
      End If
      k = k - 1
      For j = 1 To UBound(vA, 2)
         Select Case j
            Case 3
               vA(i, j) = "C_" & m
            Case Else
               vA(i, j) = m & "_" & Chr(Asc("A") + j - 1) & i
         End Select
      Next
   Next

   Application.ScreenUpdating = False
   Cells.Delete
   Range("A1").Resize(n, UBound(vA, 2)).Value = vA
   Columns.AutoFit
   ActiveSheet.UsedRange
   Application.ScreenUpdating = True
End Sub



Public Sub Samp2()
   Dim rS As Range, rE As Range, rng As Range, r As Range
   Dim i As Long
   Const CSM As String = "★☆★" ' ストッパ

   Set r = Range("H1") ' 書出し位置

   Set rS = Range("C1")
   Set rE = Cells(Rows.Count, "C").End(xlUp).Offset(1)

   Application.ScreenUpdating = False
   rE.Value = CSM
   While (rS.Value <> CSM)
      Set rng = Range(rS, rE).ColumnDifferences(rS)
      i = rng.Row - rS.Row
      With r.Resize(i + 1, 2)
         .Rows(1).Value = rS.Resize(, 2).Value
         .Rows(2).Resize(i).Value = rS.Offset(, 2).Resize(i, 2).Value
         .BorderAround xlContinuous
         .EntireColumn.AutoFit
      End With
      Set r = r.Offset(, 2)
      Set rS = rng(1)
   Wend
   rE.ClearContents
   Application.ScreenUpdating = True
End Sub

  • 質問者

    pur********さん

    2019/5/1416:04:31

    できました。。。天才です。。。
    もしお時間あればもう一点お伺いしたいのですが、、、

    弘前市    ヒロサキシ
    豊里町山根前  ハマノマチヤマネマエ
    豊里町横町   ハマノマチヨコチョウ
    登米町小島   トベイチョウコジマ

    上記のような列が右にずらーっと並んでいるのですが、
    豊里町山根前
    豊里町横町
    登米町小島
    に「弘前市」という名前を定義したいです。
    そして、それを右の列すべてに適応させたいです。

    もし可能であれば教えていただけますと嬉しい限りです。

  • その他の返信を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

tri********さん

2019/5/1410:55:11

マクロを使わないならMATCH関数とINDEX関数で工夫すればいけそうです。

変更前のリストは同じ項目名が並んでるんですよね?

まずこの範囲をMATCH関数で指定します。
項目名で一致した行~次の項目名で一致した行の1行上
で領域の行範囲が取得できます。
この領域からINDEX関数で何行目の何列目と指定して抽出すればいいです。

mit********さん

2019/5/1409:48:00

お示しの表についてどのように並び替えているのかが読み取れません。表で具体的に説明してください。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる