こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルマクロで出来れば‥

宜しくお願いいたします。エクセルでY列に商品名があります。そして、N列からX列までその商品のコードが書かれてます。何故1個のコードのものと、10個近くあるものがあるかというと、画像では書いてませんが、実は、味違いの各種があるということです。コードは抜き取りましたが、名前は一つにしてあるのです。これを、帳票からこのコードを使い各データをブイルックや、インデックス、match関数でデータを抜き取りたいのですが、横にコードを、記載したので、空白行を入れて各コードを縦書きに独立させたいのですが、手作業だと、行がいっぱいあるので、時間のロスが出てしまいます。何かいい方法あるでしょうか?お力お貸しください。

投稿日時 - 2016-03-24 22:35:58

QNo.9148287

困ってます

質問者が選んだベストアンサー

 回答No.2です。

 もしワークシート関数ではなくVBAで行う場合には、一例としては次の様なVBAとなります。


Sub QNo9148287_エクセルマクロで出来れば()

Const DataSheetName = "Sheet1" '元データが入力されているシートのシート名
Const OutputSheetName = "Sheet2" '出力先のシートのシート名
Const ProductColumn = "Y" '商品名が入力されている列の列番号
Const CodeColumn = "N:X" '商品コードが入力されている列の列番号
Const FirstRow = 1 '(項目名欄以外で)元データが入力されている行の中で最も上にある行
Const OutputCell = "A1" '出力先となるセル範囲の中で左上の隅に当たるセルのセル番号
Dim DataSheet As Worksheet, OutputSheet As Worksheet _
, LastRow As Long, myRange As Range, c As Range, i As Long

If IsError(Evaluate("ROW('" & DataSheetName & "'!A1)")) Then
MsgBox "元データが入力されているシートとして設定されている" _
& vbCrLf & vbCrLf & DataSheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "存在しないシート"
Exit Sub
End If
Set DataSheet = Sheets(DataSheetName)

LastRow = DataSheet.Range(ProductColumn & Rows.Count).End(xlUp).row
If LastRow < FirstRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

If IsError(Evaluate("ROW('" & OutputSheetName & "'!A1)")) Then
Set OutputSheet = Worksheets.Add()
OutputSheet.Name = OutputSheetName
Else
Set OutputSheet = Sheets(OutputSheetName)
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

i = -1
With OutputSheet.Range(OutputCell)
.Resize(Rows.Count - .row + 1, 2).ClearContents
For Each c In Intersect( _
DataSheet.Range(CodeColumn), _
DataSheet.Range(FirstRow & ":" & LastRow))
If c.Value <> "" Then
i = i + 1
.Offset(i).Value = c.Value
.Offset(i, 1).Value = DataSheet.Range(ProductColumn & c.row).Value
End If
Next c
End With

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

投稿日時 - 2016-03-25 04:59:53

お礼

ご回答ありがとうございます。すいません。急きょ出先になってしまい、pcが会社保管なので、できるようになってから再度お礼し直します。ありがとうございます。

投稿日時 - 2016-03-25 07:51:46

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

 もし商品名に同じ名称が重複しているものが無く、尚且つY列の途中に空欄のセルや商品名以外の値が入力されている様な事がなければ、マクロを使わずとも関数によって御質問の処理を行う事も出来ます。
 今仮に、Sheet1の1行目から元データが入力されていて、Sheet2のA列~B列の1行目以下にコードと商品名を表示させるものとします。

 その場合、まず、Sheet2のB1セルに次の関数を入力して下さい。

=IF(ROWS($B$1:$B1)>COUNT(Sheet1!$N:$X),"",IF(ROWS($B$1:$B1)=1,Sheet1!$Y$1,IF(ROWS($B$1:$B1)>COUNT(Sheet1!$N$1:INDEX(Sheet1!$X:$X,MATCH(INDEX(B:B,ROW()-1),Sheet1!$Y:$Y,0))),INDEX(Sheet1!$Y:$Y,MATCH(INDEX(B:B,ROW()-1),Sheet1!$Y:$Y,0)+1),INDEX(B:B,ROW()-1))))

 次に、Sheet2のA1セルに次の関数を入力して下さい。

=IF($B1="","",SMALL(INDEX(Sheet1!$N:$X,MATCH($B1,Sheet1!$Y:$Y,0),),COUNTIF($B$1:$B1,$B1)))

 次に、Sheet2のA1~B1のセル範囲をコピーして、Sheet2のA列~B列の2行目以下に貼り付けて下さい。

 以上です。

投稿日時 - 2016-03-25 04:54:59

お礼

ご回答ありがとうございます。急遽出先になってしまい、pcは会社保管なので、実行出来たら再度お礼し直します。ありがとうございます。

投稿日時 - 2016-03-25 07:53:39

ANo.1

要件を勘違いしていたらしみませんでし。

コード1 コード2 コード3…コード10 商品名A
コード11 コード12 商品名B

上記のように商品名単位に1行になっているのを以下のようにコード単位に複数行にしたいってことでいいですか?

コード1 商品名A
コード2 商品名A
コード3 商品名A
…省略
コード10 商品名A
コード11 商品名B
コード12 商品名B

商品名の行数にもよりますが、数十行くらいなら1行ずつコードをコピーして形式を選択して貼り付け、から行列を反転して別のシートに貼り付けをすれば縦になります。その隣の列にでも商品名をコピペする。を数十回繰り返せば終わります。

膨大な場合はこの作業を簡単にする必要があるので工夫が必要です。
例えば、Z列から右側にコード列数分を数式用セルとして用意します。
コードと商品名を結合するだけです。具体的な数式は=If(N2<>"",N2 & "tab" & $Y2),"")で良いでしょう。
コードが空白で無ければコードtab商品名という文字列がセルに表示されます。
あとは数式をを対象の数式用セルの範囲にコピペしてから、その範囲の文字列を全てコピーしてサクラエディタ等に貼り付けます。
ここからは置換の世界です。
まず、エクセルから貼り付けるとセル間はタブ区切りになっているので、正規表現を使いタブを改行に置換しましょう。¥nで改行になります。
これでエディタ上は一列になるはずなので、tabというコードと商品名の間の文字列をタブに置換しましょう。¥tで正規表現ならタブに置換出来ます。
エディタから全て選択してコピーしたらエクセルに貼り付ければコードが縦に一列に並んでその隣のセルに商品名の形式になります。

投稿日時 - 2016-03-25 00:50:23

補足

今時間が少し空いたので、パソコンはないですが、回答のして頂いたことについて質問させていただきますが、正規表現とは?キーボードに¥マークとは?すいません、理解不足で、出きるときにすぐ行いたいので今のうちに簡単でいいでさすから、宜しくお願いいたします。他回答して頂いた方は出張から戻ったら試してみますが、宜しくお願いいたします。

投稿日時 - 2016-03-25 16:10:03

お礼

ご回答ありがとうございます。急きょ出先になってしまい、pcも会社保管なので、実行出来たら再度お礼し直します。ありがとうございます。

投稿日時 - 2016-03-25 07:54:55

あなたにオススメの質問