EXCELのシートから数字を取り出すには・・・

質問

いろいろとググってみたのですが、いい結果が得られず質問します。

以下の表からなんですが、商品コードだけを取り出すにはどのような関数またはVBAをつかったらよろしいのでしょうか？ソフト等でもかまいません。
とりあえず、数字のセルさえ取り出せば、フィルタをかけて抽出できるのですが、
そこまでうまくいきません。
ご教授のほど宜しくお願いします。

回答No.1

aokii · ベストアンサー

数字のセルだけを取り出すには、未だ使っていないセルに以下の式を入れて、右と下にドラッグコピーし、全てのセルをコピーして、コピーした全てのセルに貼り付けオプションで値を貼り付け、数値以外のセルがブランクになった表を新たに作ってから、新たな表でフィルタをかけて抽出してはいかがでしょう。
=IF(ISNUMBER(A1),A1,"")

回答No.3

kagakusuki

何というシートのどの列の何行目から商品コードが入力されていて、商品コードは何行おきの行に入力されているのかという事や、抽出した商品コードを何処に出力させれば良いのかといった、「何がどうなっていて、それをどうしたいのか」という事に関する情報が殆ど何も説明されていないに近いため、それではどの様な事が出来れば上手く行った事になるのかなど他人に分かる筈が御座いません。(画像には潰れた文字の羅列が写っているだけですし、例え文字が潰れていなかったとしても、その中のどれが商品コードなのかなど、部外者に判る筈がありません)
　ですから、取り敢えずの話として、以下の様な仮定に基づいた処理を行うマクロを回答致しますので、もしそれで上手く行かない様でしたら、それは説明責任を果たしていない質問者様の責任ですので、御自身で上手く行くように手直しして下さい。

　今仮に、1段目の商品コード欄はSheet1のB3セルから右方向に向かって続いており、2段目の商品コード欄は7行目、3段目のコード欄は11行目に、という具合に4行ごとにコード欄が設けられているものとします。
　そして、マクロを使ってそれらの商品コードを全て抽出し、その抽出結果をSheet2のA3以下に昇順に並べ替えて書き込むものとします。
　上記の様な処理を行うVBAマクロで宜しければ、その一例は以下の様なものとなります。

Sub QNo8980428_EXCELのシートから数字を取り出すには()

Dim myBox, OriginalSheet As String, ExtractSheet As String, _
FirstRow As Long, FirstColumn As String, ExtractColumn As String, _
ExtractRow As Long, ItemRow As Long, myCycle As Byte, _
myWide As Long, LastRow As Long, myRow As Long

OriginalSheet = "Sheet1" '元データが存在しているシート
FirstColumn = "B" '商品コードが入力されている一番左端の列
FirstRow = 3 '商品コードが入力されている一番上の行
myCycle = 4 '何行ごとに商品コードが入力されているのかを示す行数
ExtractSheet = "Sheet2" '商品コードを抽出するシート
ExtractColumn = "A" '抽出先の列
ItemRow = 2 '抽出先の項目名が入力されている行

If IsError(Evaluate("ROW('" & OriginalSheet & "'!A1)")) Then
MsgBox "元データのシートとして設定されている" & vbCrLf & vbCrLf _
& OriginalSheet & vbCrLf & vbCrLf & _
"というシート名のシートが見つからないため、処理を行う事が出来ません。" _
& vbCrLf & "マクロの実行を中止します。", vbExclamation, "存在しないシート"
Exit Sub
End If
If IsError(Evaluate("ROW('" & ExtractSheet & "'!A1)")) Then
MsgBox "抽出先のシートとして設定されている" & vbCrLf & vbCrLf _
& ExtractSheet & vbCrLf & vbCrLf & _
"というシート名のシートが見つからないため、処理を行う事が出来ません。" _
& vbCrLf & "マクロの実行を中止します。", vbExclamation, "存在しないシート"
Exit Sub
End If

myRow = Sheets(ExtractSheet).Range(ExtractColumn & RowS.Count).End(xlUp).Row
If myRow > ItemRow Then
myBox = MsgBox("抽出先である" & ExtractSheet & "シートの" & _
ExtractColumn & ItemRow + 1 & "以下のセル範囲には既にデータが存在しています。" _
& vbCrLf & "この既存のデータを消去して、新たに抽出する商品コードのみを記録しますか?" _
& vbCrLf & vbCrLf & "[はい]:古いデータを消去して、今回抽出するデータのみを残します" _
& vbCrLf & "[いいえ]:古いデータを残したまま、その下に今回抽出するデータを追加します" _
& vbCrLf & "[キャンセル]:処理の実行を中止し、マクロを終了します", _
vbYesNoCancel + vbExclamation + vbDefaultButton2, "処理方法の選択")
Select Case myBox
Case vbYes
Sheets(ExtractSheet).Range(ExtractColumn & ItemRow + 1 & ":" & ExtractColumn & myRow).ClearContents
Case vbNo
Case Else
Exit Sub
End Select
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LastRow = Sheets(OriginalSheet).Range(FirstColumn & RowS.Count).End(xlUp).Row
myRow = FirstRow
With Sheets(ExtractSheet).Range(ExtractColumn & ItemRow)
If Len(.Value) = 0 Then .Value = "商品コード"
End With
Do Until myRow > LastRow
myWide = Sheets(OriginalSheet).Cells(myRow, Columns.Count).End(xlToLeft).Column - Columns(FirstColumn).Column + 1
Sheets(ExtractSheet).Range(ExtractColumn & RowS.Count).End(xlUp).Offset(1).Resize(myWide, 1).Value _
= WorksheetFunction.Transpose(Sheets(OriginalSheet).Range(FirstColumn & myRow).Resize(1, myWide).Value)
myRow = myRow + myCycle
Loop

With Sheets(ExtractSheet).Sort
.SortFields.Clear
.SortFields.Add Key:=Range(ExtractColumn & ItemRow)
.SetRange Range(ExtractColumn & ItemRow & ":" & ExtractColumn & Sheets(ExtractSheet).Range(ExtractColumn & RowS.Count).End(xlUp).Row)
.Header = xlYes
.Apply
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

回答No.2

keithin

とりあえずこんなカンジから応用してみて下さい。
sub macro1()
　on error resume next
　cells.specialcells(xlcelltypeconstants, xltextvalues).delete
end sub

やり方はいろいろありますが、「取り出す」って具体的にどーなって欲しいのか不明なのでびしっと回答できません。（セル結合とかあるのかとかも画像から読めないんで、そちらの対処も自力で行ってください）