エクセル2003にて VBA初心者です。

以下のようなデータがあります。
 列A    列B     列C
 識別   部品番号  ユニット
        A10000   *100
        A10001   *101
        A10002   *102
 *     A10002   *103
        A10003   *104
 *     A10003   *105
 *     A10003   *106
 ・        ・      ・
 ・        ・      ・
 ・        ・      ・

列Bには部品番号が、列Cにはユニット名が記入されています。
同じ部品番号でもユニットが異なる場合には、列Aに*が記入されています。
このようなデータが20,000行ほどあります。

上記のようなデータを以下のように並べ替えたいと考えております。
 列A    列B      列C     列D     列E
 識別   部品番号   ユニット   ユニット  ユニット
       A10000    *100
       A10001    *101
       A10002    *102     *103
       A10003    *104     *105     *106

VBAを利用すればできるんだろうなーと思っていますが、
見当もつきません。
どうぞよろしくお願いいたします。

このQ&Aに関連する最新のQ&A

A 回答 (8件)

サンプルです。



Sub Macro()
  Dim rng As Range
  Dim i As Long
  Dim j As Long
  
  Set rng = Range("A3", "A" & Range("B" & Rows.Count).End(xlUp).Row)
  Set rng = rng.SpecialCells(xlCellTypeConstants, 2)
  For i = 1 To rng.Areas.Count
    For j = 1 To rng.Areas(i).Count
      With rng.Areas(i).Item(j)
        .Offset(-j, j + 2).Value = .Offset(, 2).Value
      End With
    Next j
  Next i
  rng.EntireRow.Delete
End Sub

>VBAを利用すればできるんだろうなーと思っていますが、
>見当もつきません。
手作業ではどうしますか?
手作業を「マクロの記録」すれば参考コードが得られます。
    • good
    • 0
この回答へのお礼

さっそくのご回答ありがとうございます。

このサンプルを実行すると、
C列のデータが一行目のD列から最終列(IV列)まで転写され
エラーメッセージが出てしまいます。

私のやり方がどこかまずいのでしょうか?
それともサンプルはあくまでもサンプルであり、
このサンプルをベースにIF文等を加えないと問題は解決できない
ということなのでしょうか?

重ね重ねの質問で申し訳ありませんがよろしくお願い致します。

お礼日時:2009/05/16 16:10

Wendy02さん


>rng.Columns(1).Value = rng.Columns(1).Value
「参考になった」ボタンをClickしました。
ありがとうございました。

""以外に、スペース、Alt+Enter、CHAR(10)等にも対応できないか考えてみました。
nankoro_xさんの補足によれば「*」セル以外は「空白」セルという認識で問題ないようです。
「セル選択」で「選択オプション」にある「アクティブ列との相違」を利用し

Dim frng As Range

Set rng = Range("A4", "A" & Range("B" & Rows.Count).End(xlUp).Row)
With rng
  Set frng = .Find(what:="*", After:=.Cells(.Count), LookIn:=xlValues)
End With
rng.ColumnDifferences(frng).ClearContents
Set rng = rng.SpecialCells(xlCellTypeConstants, 2)

と、こんな風にしてみましたが、どうでしょうか。
    • good
    • 0

xls88さん


nankoro_xさん

こんばんは。

xls88さん、私の書いたものを読んでいただきありがとうございました。
#1のコードを試して、私が試した方法は、一旦、数式を作っておいて、それを値貼り付けしてみました。目では、"" は消えているのですが、SpecialCells を試してみると、Area が、ひとつにまとまってしまいました。

そこで、私の一案ですが、

Set rng = Range("A3", "A" & Range("B" & Rows.Count).End(xlUp).Row) 
rng.Columns(1).Value = rng.Columns(1).Value '←このコードを入れてみました。
Set rng = rng.SpecialCells(xlCellTypeConstants, 2)

私の作ったサンプルの場合は、成功しました。
ご質問者さんに対しては、必ず上手くいくとは保証できないのですが、「"" 」残っている場合は、.Value = .Value で消せるのです。
    • good
    • 0
この回答へのお礼

ご指摘ありがとうございます。
無事に問題を解決することができました。

お礼日時:2009/05/17 07:59

>先ほどのプログラムの意味を調べる所から始めてみます。


是非そうしてください。
その姿勢があれば、必ずVBAの使い手として上達されると思います。
解らないところがあれば、遠慮なく補足してください、解る範囲でお答えしたいと思います。

私が提示したコードは、A列で、文字(「*」に限らない)が入力されているセルを抽出し、その後の処理の基準にしています。
問題は、Wendy02さんが指摘されているように、空白セルは、実は空白ではなく空白に見えているセルだということだと思います。
1行目ではなく、2行目に転記されるということは、A2セルのみ真正の空白セルだと思います。

先のコードに、★のところを追加してみてください。

Set rng = rng.SpecialCells(xlCellTypeConstants, 2)
MsgBox rng.Address '★

実行すると、メッセージボックスにセル範囲アドレスが表示されます。
空白に見えるセルが、表示されたセル範囲に含まれていると思います。
対応策が、他の方々から提案されています。参考にしてください。
他には、検索で、*セルを抽出する手もあるとおもいます。

ご存知かもしれませんが
VBEのコードウィンドウで、調べたい単語の中に文字カーソルを置いた状態で、F1キーを押してください。
目的の単語のページにジャンプして、ヘルプが表示されます。

デバッグについて
http://members.jcom.home.ne.jp/rex-uchida/vba110 …
ブレークポイント
http://www.vba-world.com/breakpoint.html
    • good
    • 0
この回答へのお礼

いろいろとご教授頂きありがとうございます。

無事に解決することができました。
本当にありがとうございます。

A列ですが、
=IF(COUNTIF($B$2:B2,B2>1),"*","")
という関数で二個目以降の同一部品番号に*をつけた後、
値コピーしたものです。
値コピーすれば空白か*のみになると考えておりました。
私の前提条件の提示が足りませんでした。
申し訳ございませんでした。

xls88様のコードに、Wendy02様の提示された1行を追加したところ
うまくいきました。
本当にありがとうございました。

お礼日時:2009/05/17 07:54

>このサンプルをベースにIF文等を加えないと問題は解決できない


ということなのでしょうか?

そうですね。そう思います。
質問文にあるとおりのデータを手で入力して、#01さんのマクロを実行すればちゃんと動きます。試されましたか?
それが動かないとすれば「実際のデータには質問文に書かれていない『何か』があるから」ではないでしょうか。

例えば「部品番号が昇順になっていなくて同じ番号が繰り返し出現する」、「一つの部品番号が256以上のユニットで利用されている」、「A列の*は関数で表示している」などです。

実際のデータが分からないのでB列、C列のデータだけで処理するようにしてみました。A列のデータに意味があるならご自身で書き換えてください

Sub Macro1()
Dim ws As Worksheet
Dim idx, ptr As Long
Dim trg As Range
  Set ws = ActiveSheet
  On Error GoTo end0
  Application.ScreenUpdating = False
  Worksheets.Add after:=ws
  With ws
    .Rows(1).Copy Destination:=Rows(1)
    For idx = 2 To .Range("B65536").End(xlUp).Row
      If .Cells(idx, "B").Value <> "" Then
        Set trg = ActiveSheet.Columns(2).Find(what:=.Cells(idx, "B").Value, _
              LookIn:=xlValues, Lookat:=xlWhole)
        If trg Is Nothing Then
          Range("B65536").End(xlUp).Offset(1, 0).Value = .Cells(idx, "B").Value
          ptr = Range("B65536").End(xlUp).Row
        Else
          ptr = trg.Row
        End If
        If Application.CountIf(Rows(ptr), .Cells(idx, "C").Value) = 0 Then
          If Cells(ptr, "IV").Value = "" Then
            Cells(ptr, "IV").End(xlToLeft).Offset(0, 1).Value = _
              .Cells(idx, "C").Value
          Else
            MsgBox "列数が256を超えるので処理できません"
            Exit For
          End If
        End If
        Set trg = Nothing
      End If
    Next idx
  End With
end0:
  Application.ScreenUpdating = True
End Sub
    • good
    • 0
この回答へのお礼

無事に問題を解決することができました。
ありがとうございました。

お礼日時:2009/05/17 08:00

こんにちは。



まず、#1さんのコードは、問題ないはずなのですが、その「識別」が付けられた過程を考えたときに、数式でできていたのではないでしょうか。仮に、文字として、定数になっていても、空白部分が完全に空白になっていないのではないか、と思います。値貼り付けでは、どうやら痕跡が残るようですから、SpecialCells 以外のマクロによる、完全空白する処理が必要かもしれません。

そこで、私は、その質問の表を見たときに、その「識別」をまったくアテにしないことを考えました。2万行ということになると、最後まで信頼置けないような気がしました。そこで、「識別」を頼りにせず、独自に、配列で確保しながら、配列を使って、表を作ることにしました。データが、20,000件ですから、まあ、そこそこに動くレベルだと思います。それ以上のスピードを稼ぐものは、あまり思い当たらないです。

以下は、シート2に書き出すようにはなっていますが、その設定は、任意にしてください。

Sub ArrangeLines()
  '部品番号はソートされていることが条件
  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Dim rng As Range
  Dim i As Long, j As Long, k As Long
  Dim mx As Integer
  Dim v As Variant
  Dim ar As Variant
  Dim ar2 As Variant
  Dim art()
  Dim arb() As String
  Dim buf As String
  Dim flg As Boolean
  '-------------------------------------------
  Set sh1 = Worksheets("Sheet1") 'オリジナル・データシート
  Const O As String = "A1" 'オリジナルデータの左上端
  
  Set sh2 = Worksheets("Sheet2") 'データの書き出しシート
  Const P As String = "A1" 'データの書き出し場所端
  '-------------------------------------------
  With sh1
    Set rng = .Range(O).Range("B1", .Range("B65536").End(xlUp))
  End With
  sh2.Range(P).CurrentRegion.ClearContents
  ar = Application.Transpose(rng.Offset(1).Value)
  ar2 = Application.Transpose(rng.Offset(1, 1).Value)
  
  
  For i = LBound(ar) To UBound(ar) - 1
    If buf = "" Then
      buf = Trim(ar(i))
    End If
    If ar(i) <> ar(i + 1) Then
      buf = buf & "," & ar2(i)
      j = j + 1
      ReDim Preserve art(j)
      flg = True
    Else
      buf = buf & "," & Trim(ar2(i))
    End If
    If flg Then
      k = Len(buf) - Len(Replace(buf, ",", ""))
      If mx < k Then
        mx = k
      End If
      art(j) = buf
      buf = ""
      flg = False
    End If
  Next i
  ReDim arb(mx, UBound(art))
  j = 0
  For i = LBound(art) To UBound(art)
    If Not IsEmpty(art(i)) Then
      For Each v In Split(art(i), ",")
        arb(j, i - 1) = v
        j = j + 1
      Next v
    End If
    j = 0
  Next i
  With sh2
    If k > 256 - Range(P).Row - 1 Then k = 256 - Range(P).Row - 1 'Ver.2003 まで
    sh1.Range(O).Resize(, 3).Copy .Range(P)
    .Range(P).Offset(, 2).Copy .Range(P).Offset(, 3).Resize(, k - 1)
    .Range(P).Offset(1, 1).Resize(UBound(arb, 2) + 1, k + 1).Value = _
    Application.Transpose(arb())
  End With

End Sub
    • good
    • 0
この回答へのお礼

無事に問題を解決することができました。
ありがとうございました。

お礼日時:2009/05/17 08:01

>見当もつきません。


表の体裁の組み換え(VBAで)は結構難しく中級以上の者の課題です。まだ早すぎる。だから丸投げになってしまうが、本質問コーナーに回答者にコードを書かせるのは規約違反です。下請け機関ではない。
ーー
本件には、ソート法が良かろう。
A1002の行を処理しているとき、次にA1000が出てきては困るからです。結果表を見れば判るとおり、
部品番号+ユニットの順に出てきてほしいのでその2列で昇順にソートする。同じ部品番号で同じユニットが複数出てくるのか質問に書いてないが、重要ポイントで、経験のなさを示している。無いとして、
Sheet2の列C、数字で言うと3からSheet1を1行読むごとにSheet2の列に順次ずらして書き出す。そのためには、書き出す列を示すポインター(変数)を持つ。Sheet1の1行読むごとに、ポインターを+1する。しかし
Sheet1で部品番号が変わったら、ポインターをC列数字で3にリセットする。
そのために直前の部品番号を記憶する変数を作り、次の行を呼んだとき毎回前行と比較して、変わったか判定する。
(A)部品番号が変わった
次行をさす。そして列はC列 に書く
(B)部品番号が変わらない
右隣列 に書く
==
ほかに
●Cells(i、j)の使い方知ってますか。
●最終行まで上記の処理を繰り返しますが、最終行の捉え方を知ってますか。
●現データと別の他シートへ結果表(Sheet2)書き出すを希望するなら
その表現法(コード)を知ってますか。
判らないなら、人のコードを盗めば何てこと無いものだが、判らないまま使うということになる。こういう本番のずっと前に、日ごろから後日に備え、他人の書いたコードを勉強して、頭に整理して無いと出来ないのです。
    • good
    • 0
この回答へのお礼

おっしゃる通りだと思います。
今回の教訓を糧に勉強に勤しみます。
ありがとうございました。

お礼日時:2009/05/17 08:04

提示された例題が、現状をありのままに表現されていればサンプルでも結果が得られるはずです。


もしかすると、A列に空白セルはなく、*以外のデータで埋まっているということでしょうか?
もし例題が仮定だとすると、実際に合わせて編集する必要があります。
編集できないのなら、実際の情報を現状に則して提供してみてください。
    • good
    • 0
この回答へのお礼

さっそくのご回答ありがとうございます。

実行結果ですが、先ほどは1行目のD列から・・・と
記述いたしましたが、2行目のD列からの間違いでした。
申し訳ございません。

実際のデータも例と同じく、
1行目のA列に"識別"、B列に"部品番号"、C列に"ユニット"と見出しがあり、
データは2行目から始まっています。
また、A列は空白セルか*しかありません。

先ほどご教授頂きましたプログラムの意味が理解できていないので、
どこが問題なのか全く把握できていないのが現状です。
自分で理解しようともせずに
xls88様にあまりにも丸投げしていましたので、
先ほどのプログラムの意味を調べる所から始めてみます。
ありがとうございました。

お礼日時:2009/05/16 18:01

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング