痔になりやすい生活習慣とは?

特定の数値があるセルと、そのセルがある行の左端から3列目までを別シートに抽出したいです。
下の画像ですと、D列からI列の中で『2017/06』が含まれるセルと、そのセルがある行のA列からC列を別シートに抜き出して『2017/06』分の表を作りたいです。
また、9行目からも新しく氏名、商品、回数などデータを足していく予定です。
データ量が膨大なので、作業の効率化を図りたいです。

お手数おかけしますが、どうぞよろしくお願いいたします。

「特定の数値があるセルと、そのセルがある行」の質問画像

A 回答 (1件)

画像のシート名(元データのあるシート)を「データ」、結果を表示するシート名を「抽出」とします。


抽出シートの1行目にはA1~C1に 氏名、商品、回数 という見出しがあるとします。
抽出する月はその都度指定させる方法としての1例ですが、
VBAの標準モジュールに以下のコードをコピーして、これを実行すれば抽出できます。


Sub データ抽出()

Dim mySh1 As Worksheet
Dim mySh2 As Worksheet
Dim arrData(1 To 9) As Variant
Dim Asp As String
Dim RowCount1 As Long
Dim RowCount2 As Long
Dim MatchFLG As Boolean
Dim I As Integer
Dim J As Integer

Set mySh1 = Worksheets("データ")
Set mySh2 = Worksheets("抽出")

'抽出シートを1行目を残してクリアする
RowCount2 = mySh2.Cells(Rows.Count, "A").End(xlUp).Row
If RowCount2 > 1 Then
  mySh2.Rows("2:" & RowCount2).Delete
End If

'条件にマッチするデータを検索
RowCount1 = mySh1.Cells(Rows.Count, "A").End(xlUp).Row
Asp = InputBox("抽出日")

For I = 4 To RowCount1
  MatchFLG = False
  For J = 3 To 8
   If Format(mySh1.Range("A" & I).Offset(0, J), "yyyy/mm") = Asp Then
     MatchFLG = True
   End If
  Next J
  If MatchFLG Then
    GoSub DataSet
  End If
Next I

GoTo subEND

'抽出シートにデータを書き込む
DataSet:
  RowCount2 = mySh2.Cells(Rows.Count, "A").End(xlUp).Row
  mySh2.Range("A" & RowCount2 + 1).Offset(0, 0) = mySh1.Range("A" & I).Offset(0, 0)
  mySh2.Range("A" & RowCount2 + 1).Offset(0, 1) = mySh1.Range("A" & I).Offset(0, 1)
  mySh2.Range("A" & RowCount2 + 1).Offset(0, 2) = mySh1.Range("A" & I).Offset(0, 2)
Return

subEND:
  Set mySh1 = Nothing
  Set mySh2 = Nothing
  MsgBox "END"

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

Sand_Dollar様
ご回答いただきありがとうございます!
回答のつづきが何故かすぐに見れなくて返信が遅くなりすみませんm(._.)m
早速、明日会社のパソコンで出来るかいただいたコードを入れてみたいとおもいます。
非常に困っていたので助かります!!!

お礼日時:2017/09/26 21:23

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

このQ&Aと関連する良く見られている質問

Qエクセルで 異なるデータを含む2つのデータを 1つの表にまとめる方法を教えてください

初めて質問をします。
あまりエクセルが詳しくなく わからないので 教えて下さい。

2つのデータがあります。
Aには仕入れ数、Bには売り上げ数があります。
双方の商品名はすべて一致するわけではなく、「AにあってBにない」「BにあってAがない」ものもあります。


    データA 【仕入れ】     データB 【売上】

管理No 商品  仕入れ数   管理No 商品   売上数
   1  りんご  3        2  みかん  8
   2  みかん  8       3    バナナ    3
   3  バナナ    4      1  りんご    2
   4  いちご    1      7   もも     3
   5  オレンジ  3      10    キウイ     2
   6  レモン    3     11    ぶどう     2
   7  もも     3     13    大根      1
   8  なし     2
   9  カキ    5
  10  キウイ  2
  11  ぶどう    1
  12   マンゴー   1


上記の2つのデータを以下のようにまとめたいのですが 可能でしょうか?
(ABすべての商品名を出して それぞれの数を表示する)

管理No   商品    仕入れ数      売上数
   1   りんご      3        2
   2   みかん      8      8
    3   ばなな      4        3
   4   いちご      1        0
   5    オレンジ  3        0
   6   レモン      3     0
   7   もも       3     3
   8   なし       2     0
   9   カキ      5     0
   10   キウイ      2      2
   11   ぶどう      1       2
   12   マンゴー    1      0
   13   大根      0      1
      


数字がずれていてすみません。
どうぞよろしくお願いします。

初めて質問をします。
あまりエクセルが詳しくなく わからないので 教えて下さい。

2つのデータがあります。
Aには仕入れ数、Bには売り上げ数があります。
双方の商品名はすべて一致するわけではなく、「AにあってBにない」「BにあってAがない」ものもあります。


    データA 【仕入れ】     データB 【売上】

管理No 商品  仕入れ数   管理No 商品   売上数
   1  りんご  3        2  みかん  8
   2  みかん  8       ...続きを読む

Aベストアンサー

こんにちは!

>(ABすべての商品名を出して それぞれの数を表示する)
というコトですので、手っ取り早くVBAでの一例です。

↓の画像のようにそれぞれのシート名は「仕入れ」・「売上」となっていて、Sheet3に表示するとします。
尚、「商品」の「管理No」はシリアルナンバーのように決まっているものとします。
そして、Sheet3の1行目項目行は入力済みという前提です。

Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)マクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub Sample1() '//この行から//
Dim i As Long, lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
Dim c As Range, r As Range
Dim wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("仕入れ")
Set wS2 = Worksheets("売上")
Application.ScreenUpdating = False
With Worksheets("Sheet3") '//←「Sheet3」はまとめるシート名に!"//
lastRow3 = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow3 > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow3, "D")).ClearContents
End If
.Range("E:F").Insert
lastRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(lastRow1, "A")).Copy .Range("E1")
lastRow2 = wS2.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS2.Cells(2, "A"), wS2.Cells(lastRow2, "A")).Copy .Cells(Rows.Count, "E").End(xlUp).Offset(1)
.Range("E:E").AdvancedFilter Action:=xlFilterCopy, copytorange:=.Range("F1"), unique:=True
.Range("F:F").Sort key1:=.Range("F1"), order1:=xlAscending, Header:=xlYes
lastRow3 = .Cells(Rows.Count, "F").End(xlUp).Row
Range(.Cells(2, "F"), .Cells(lastRow3, "F")).Copy .Range("A2")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS1.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(i, "B") = c.Offset(, 1)
.Cells(i, "C") = c.Offset(, 2)
End If
Set r = wS2.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
If .Cells(i, "B") = "" Then
.Cells(i, "B") = r.Offset(, 1)
End If
.Cells(i, "D") = r.Offset(, 2)
End If
Next i
.Range("E:F").Delete
.Columns.AutoFit
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub '//この行まで//

※ 関数でないので、データ変更があるたびにマクロを実行する必要があります。

※ コード内の「Sheet3」の部分は実際のシート名に変更してください。m(_ _)m

こんにちは!

>(ABすべての商品名を出して それぞれの数を表示する)
というコトですので、手っ取り早くVBAでの一例です。

↓の画像のようにそれぞれのシート名は「仕入れ」・「売上」となっていて、Sheet3に表示するとします。
尚、「商品」の「管理No」はシリアルナンバーのように決まっているものとします。
そして、Sheet3の1行目項目行は入力済みという前提です。

Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → ...続きを読む

Qエクセルで見えないが、何かがまだは言っているのを取りのぞくにはどうすればいい。

教えてください。

エクセルのA1に「〇○錠 1.5錠」、A2に「〇○錠 3錠」としてある場合。
「〇○錠     」とだけするために、1.5錠を「””」、3錠を「""」として変換して
一応消されはするのですが、ピポットテーブルにのせると同じものと認識しないが、
これにはなにか残っているようなのですが・・。これを消して同じものとして
認識するためにはどうすればいいか。クリーン関数などというのもあるようだが、使い方が
わからない。

Aベストアンサー

>1.5錠を「””」、3錠を「""」として変換して

これ、どうやったんですか?数式?
置換機能?
◯◯錠の後ろにスペースが残っているのでは?

=CLEAN(TRIM(A1))

とかで、一度にやってしまったら如何でしょうか?

QエクセルでLOOKUP関数など使いこなせない

体力測定記録で年齢、得点を入れたら評定基準でABCDを返すようにしたい。
例えば  年齢72 得点35     評定段階 C
Cを求める数式を知りたい。どなたかよろしくお願いします。

Aベストアンサー

こんにちは!

一例です。
↓の画像のE1~H6セルのように表を作成しておきます。

C2セルに
=IF(COUNTBLANK(A2:B2),"",INDEX(E$2:E$6,MATCH(B2,OFFSET(E$2:E$6,,MATCH(A2,F$1:H$1,1)),1)))

という数式を入れフィルハンドルで下へコピーしています。

※ 表の並びを少しだけ説明すると・・・
F列 → 0歳以上~70歳未満
G列 → 70歳以上~75歳未満
H列 → 75歳以上
となり、行方向に関しても同様な区分けになり、
仮にF列の場合は
2行目 → 0以上~25未満
3行目 → 25以上~33未満
4行目 → 33以上~41未満
5行目 → 41以上~49未満
6行目 → 49以上
といった具合です。

他の列も同様の感じになります。m(_ _)m

QExcel関数で、文字を数字に変換させたいです。 if関数で、数字を文字で表示させることは出来ますが

Excel関数で、文字を数字に変換させたいです。
if関数で、数字を文字で表示させることは出来ますが、その逆はできるのでしょうか?
また、その列を数字の合計で出すことはできますか?

Aベストアンサー

>>例えば、非を1、定を0として表示させることはできますか?

=IF(A1="非",1,IF(A1="定",0,""))

QVBAで名前検索と可視セル数値の別シート貼り付け

VBAに詳しい方、たすけてください。
Excel2010のVBAで下記のように動くプログラムを組んではいただけないでしょうか。

①ExcelのBook全体のD列をユーザーが入力した任意の文字で検索する(テ

キストボックスを表示する)
②検索結果の文字の1個下の行に入った数値の合計を、検索した時に入力した文字数と一緒に「計算結果」というシートに貼り付ける。
例:検索した名前が「たまねぎ」で、その名前がsheet1のD3にあったら4行目の可視セルに入った数値の合計と名前をシート「計算結果」に貼り付ける。

※sheet2のD7にも同名の「たまねぎ」があった場合、8行目の可視セルの合計を加算して、総計を返す。返す値はブック全体の名前検索結果の1つ下の行の可視セルの合計。

シート「計算結果」
A1 B1
たまねぎ 合計(全シートのD列にたまねぎが入った行の、
1つ下の行の可視セルの合計)
貼り付けの際、A1とB1に既に別の文字と数値が入っていた際は
次の空白の行A2とB2に貼り付ける(空白のセルに貼り付ける)

VBAに詳しい方、たすけてください。
Excel2010のVBAで下記のように動くプログラムを組んではいただけないでしょうか。

①ExcelのBook全体のD列をユーザーが入力した任意の文字で検索する(テ

キストボックスを表示する)
②検索結果の文字の1個下の行に入った数値の合計を、検索した時に入力した文字数と一緒に「計算結果」というシートに貼り付ける。
例:検索した名前が「たまねぎ」で、その名前がsheet1のD3にあったら4行目の可視セルに入った数値の合計と名前をシート「計算結果」に貼り付ける。
...続きを読む

Aベストアンサー

続けてお邪魔します。

結局各シートのD列を検索し、D列に対象品名があればその1行下のK~BT列の数値を合計すれば良いのですね?
↓のコードにしてみてください。

Sub Sample2()
Dim k As Long, myRow As Long, myFlg As Boolean
Dim myStr As String, wS As Worksheet
Dim myRng As Range, myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> .Name Then
Set wS = Worksheets(k)
Set myFound = wS.Range("D:D").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
If Not myFound Is Nothing Then
.Cells(myRow, "A") = myStr
myFlg = True
Set myFirst = myFound
GoTo 処理
Do
Set myFound = wS.Range("D:D").FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
GoTo 処理
処理:
Set myRng = Range(wS.Cells(myFound.Row + 1, "K"), wS.Cells(myFound.Row + 1, "BT"))
With .Cells(myRow, "B")
.Value = .Value + WorksheetFunction.Sum(myRng)
End With
Loop
End If
End If
Next k
If myFlg = False Then
MsgBox "該当品目なし"
End If
End With
End Sub

今度はどうでしょうか?m(_ _)m

続けてお邪魔します。

結局各シートのD列を検索し、D列に対象品名があればその1行下のK~BT列の数値を合計すれば良いのですね?
↓のコードにしてみてください。

Sub Sample2()
Dim k As Long, myRow As Long, myFlg As Boolean
Dim myStr As String, wS As Worksheet
Dim myRng As Range, myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For k =...続きを読む

Qエクセルでひとつのセルに複数の年月日が入力されていて、それぞれを単セル毎にわけたい。

エクセルでひとつのセルに複数の年月日が下記のように入力されていて
それを単セル毎に分けたいのですがどのようにしたらよいのでしょうか
VBAではなく関数や式を用いておねがいします。
(例)
(A1に改行入りで入力されている)→ (単セル毎にわけたい)
変更前                       変更後
2017/2/3              B1セル→   2017/2/3 
2017/2/4              B2セル→   2017/2/4
2017/2/5              B3セル→   2017/2/5

Aベストアンサー

こんばんは!

横からお邪魔します。
処理するのはA1セルの文字列だけでよいのですね?
VBAでの一例です。

Sub Sample1()
Dim k As Long, myAry As Variant
myAry = Split(Range("A1"), vbLf)
For k = 0 To UBound(myAry)
Cells(k + 1, "B") = myAry(k)
Next k
End Sub

こんな感じで大丈夫だと思います。m(_ _)m

Qエクセルの式を一時的に止めて表の編集後に式を復活させることはできますか?

エクセルの式が入った表を編集するのに時間がかかって苦労してます。ほかの表ともリンクしており一時的にすべての式を止めてデータだけを打ち込んでから最後に式を復活することができたら作業効率が飛躍的に向上すると思うのですがどなたか便利な方法を教えてください。

Aベストアンサー

こんにちは

式を修正する度に自動計算が働くのを止めたいという意味と推測しました。

エクセルのオプションから「数式」-「計算方法の設定」で一旦、「手動」に設定しておきます。
式の修正作業終了後に、元に戻せば宜しいのではないでしょうか?

Qエクセル セル内の除去について

エクセルのセル一つについて 「〇○○  ×××  」と文字○があった場合、〇○○の右の空白のスペースからすべて右側を×××を含めて除去する方法はありませんか。〇○○、×××の文字、文字数はセルごとに違うものとします。

Aベストアンサー

例えば、
A1に、

> 「〇○○  ×××  」

が入力されているとして、

B1に、
=FIND(" ",A1)
で最初に空白文字が現れる文字の場所を取得。

C1に、
=LEFT(A1,B1-1)
で最初に空白が現れるより左の文字列を取得。

とか。

QWorksheet_Change(ByVal Target As Range)の下に複数範囲

始めまして

Private Sub Worksheet_Change(ByVal Target As Range)が全然整理できないので
アドバイスいただけますか
私の能力は
1、N88 BASIC を少しかじりました
2、エクセルで式の入力は少しできます(ロータス123も少しやりました)
3、昔、クイックベーシックはギブアップしました

最近ずっと、知恵袋やここのgooのエクセルの掲示板から、やりたいことを
可能にしてくれるマクロを探しているのですが、いろいろな表現があって、全然整理できません
例えば下記のマクロなどです(行には自分でメモを書いています)

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  '複数個所同時入力を拒否する?  
  If ActiveSheet.AutoFilterMode Then Exit Sub
  'AutoFilterModeだったら拒否する
  If Not Intersect(Target, Range("A1:D4")) Is Nothing Then
  MsgBox Target.Address '実際の処理
  End If
End Sub

さらには
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1")) Is Nothing Then
  'A1の値が変わった
    MsgBox "セル A1 が変更になりました。" ' <--- A1変更時の処理
  End If
  If Not Intersect(Target, Range("B1")) Is Nothing Then
    MsgBox "セル B1 が変更になりました。" ' <--- B1変更時の処理
  End If
  If Not Intersect(Target, Range("C1")) Is Nothing Then
    MsgBox "セル C1 が変更になりました。" ' <--- C1変更時の処理
  End If
End Sub

など・・・
他にも
Dim myRng As Range
Dim r As Range
を使いなさいとか

さらには、

Application.EnableEvents = False
Application.EnableEvents = TRUE
を使いなさい

そのマクロ自体が、別のセルを代入したりすると、もうひとつのイベントを発生させてしまい、プロシージャの中で、無限ループに近い形になっています。(ただし、完全な無限ループではないので、1万回程度で止まります。)そこで、その無限ループをとめなくてはならないので、そうした、
Application.EnableEvents = False
ということをします。

などです

===================================================

そこで、さっぱり整理できないので、自分がやりたいことはマクロでどう書けば良いのかを
教えていただければと思います
教えていただいてから、ひとつ、ひとつ検索して勉強します

下記がマクロでやりたいことです

===================================================
入力を監視するセルは下記の範囲で、範囲ごとにやること(処理)は違います
入力は全て整数です(整数が入力されたらその値に応じてマクロで処理します)
入力値のチェックは「入力規則」でやります(IF文書くのがたいへんそうなので)

入力範囲は

Range("B2,D2,H2,J2")
Range("B3,D3,H3,J3")
Range("B5:B100") 
この範囲に値の貼り付けで入力は禁止です、というか、禁止しないと
だめなようです(Worksheet_Changeは)

Range("H5:H100")
この範囲に値の貼り付けで入力は禁止です、というか、禁止しないと
だめなようです(Worksheet_Changeは)

もっと増えるかもしれませんが、その時はなんとか教えていただいた例を参考にやってみます
いきなりの長文の質問ですみません

用語に不慣れで表現が分かりにくかったら指摘してください
よろしくお願いします
エクセルはバージョン2013を使っています
最後まで読んでいただきましてありがとうございました

始めまして

Private Sub Worksheet_Change(ByVal Target As Range)が全然整理できないので
アドバイスいただけますか
私の能力は
1、N88 BASIC を少しかじりました
2、エクセルで式の入力は少しできます(ロータス123も少しやりました)
3、昔、クイックベーシックはギブアップしました

最近ずっと、知恵袋やここのgooのエクセルの掲示板から、やりたいことを
可能にしてくれるマクロを探しているのですが、いろいろな表現があって、全然整理できません
例えば下記のマクロなどです(行には自分...続きを読む

Aベストアンサー

こんにちは。

>Application.EnableEvents = False の効果を知るには、無限ループになるようなコードが
書けないとだめということですね
>「そんなコードが書けないのだから、効果を実感できるわけがない」という話ですね
>やっと合点しました

私は、そこまで言うつもりはありません。最初は形式的に書いていて、そのうちに分かるようになるということです。実際に、今、「そんなコード」を本当に書ける人がいるのでしょうか?

らしきコードを書いてみましたが、これでも、実証はできません。途中でエラーがでてしまいます。止める場合は、ESCキーを押します。

'A2に値をいれるマクロ
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Target.Value = "" Then Exit Sub
 If Target.Address(0, 0) <> "A2" Then Exit Sub
'以上除外設定
Application.EnableEvents = False
Target.Value = Target.Value + 1  '値に値を入れるから保護する必要があります。
Application.EnableEvents = True
If Target.Value > 10 Then Exit Sub  '再帰になって場合の気休め。実際は働かない
 Exit Sub
End Sub

最近は、PCそのものの性能がよいせいか、忘れてしまう人がいます。無限ループにならないのは、一回のイベントにわずかなタイムラグが出来て、そのタイムラグが、イベントをキャッチする時間の範囲から外れてしまうから、イベントが終了するわけです。

以下の場合は、EnableEvents =False は、不要です。
マクロで値を入れた時に、再イベントが発生するのです。だから、それを防ぐわけです。
-----------------
 If Not Intersect(Target, Range("B2,D2")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If

If Not Intersect(Target, Range("B5:B10,D5:D10")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If
-----------------

>マクロがエラーで止まって、エラーの行が黄色くなって
>コードが示されるようなことでは、逆にマクロなんか使わない方がよさそうです

問題は、そういう所ではないのです。
最初は、プログラムそのものを体得していくことだと思います。
上達のポイントは、なんとか、何年掛かってもよいからと思いつつ、完成を目指すことです。

その都度、覚えた技術を反映しながら、自分のコレクションに加えていきます。

また、ネットで勉強するにしても、なるべく一定の人のものを追いかけて、その人がどう考えて、そのコードになったのか考えながらでもよいと思います。ある程度の内容になると、その人の人柄がコードに出てきます。

マクロで、自分がやりたいことができるようになるには、なかなか時間が掛かります。でも、それ以上に、相手の期待に沿うというのは、もっと大変なことです。

最近、質問した人は、私の説明を読んで、すぐに諦めてしまって質問を閉じてしまいました。こちらも事情があって、その人のために、大掛かりなプログラムを簡単に公開したくはありません。人にやる気を起こさせるのも技術かもしれません。中には、長いコードをみただけで、自分の質問とは違います、と断ってしまう人。せっかく作っても、予定に間に合わなかったので、ボツ。エラー処理したコードは、内容が複雑になっているから、それはダメ。

他人のためにマクロを書くと考えていたら、とてもやっていられるものではありません。

こんにちは。

>Application.EnableEvents = False の効果を知るには、無限ループになるようなコードが
書けないとだめということですね
>「そんなコードが書けないのだから、効果を実感できるわけがない」という話ですね
>やっと合点しました

私は、そこまで言うつもりはありません。最初は形式的に書いていて、そのうちに分かるようになるということです。実際に、今、「そんなコード」を本当に書ける人がいるのでしょうか?

らしきコードを書いてみましたが、これでも、実証はできません。途中でエラーがで...続きを読む

QExcel 一括並べ替えについて

A30からY47の範囲で一括並べ替えをしたいのですが
マクロを組めば画像(矢印下の図表)のように並び替える事は可能でしょうか?

毎回コピーペーストでやっていますが、流石に時間ばかり掛かってしんどいです。

マクロや関数などの知識はありません。

知識が必要でしたら、学習用のサイトなども併せてご紹介をお願いします。



※画像が小さくてわかりにくいかもしれませんがどうぞよろしくお願い致します。

Aベストアンサー

No7です。補足了解しました。
以下のマクロを標準モジュールに登録してください。
-----------------------------------------------
Option Explicit
Public Sub 並べ替え()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim col1 As Long
Dim row2 As Long
Dim col2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Columns("Z").Clear
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cells(row2, "Z").Value = sh1.Cells(row1, col1).Value
row2 = row2 + 1
Next
Next
Call sh2.Range("Z1:Z" & row2 - 1).Sort(Key1:=sh2.Range("Z1"), Header:=xlNo)
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cells(row1, col1).Value = sh2.Cells(row2, "Z").Value
row2 = row2 + 1
Next
Next
sh2.Columns("Z").Clear
MsgBox ("完了")
End Sub
------------------------------------------------------------------------

No7です。補足了解しました。
以下のマクロを標準モジュールに登録してください。
-----------------------------------------------
Option Explicit
Public Sub 並べ替え()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim col1 As Long
Dim row2 As Long
Dim col2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Columns("Z").Clear
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cel...続きを読む


人気Q&Aランキング