- 締切済み
エクセルのマクロについてです
あるソフトから出力したテキストデータを エクセルに取り込んで入庫台帳をつくっています。 A列~I列まで項目があり 1行目に項目名があります A2 日付 B2 購入先 C2品名 D2 包装の数 E2~G2 今回関係ない項目 H2 購入金額 このデータから 「同じ品物を複数の購入先から買っている 場合 そのデータを知りたい」 のが目的です まずH列に Range(Cells(2, 9), Cells(Cells(65536, 1).End(xlUp).Row, 9)).Formula = "=COUNTIF($C$2:" & Range("A65536").End(xlUp).Address & ",C2)" といれてC列の中に品名自身が何個あるかを H列に表示させました フィルタをH列でかけて「2以上」を表示させるところまでなんとかできたのですが それから先をどうしたらいいか 御教授いただけますか?
- ennkai
- お礼率54% (284/525)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 (1)
- 専門家の回答
みんなの回答
- error123
- ベストアンサー率21% (54/247)
> それから先をどうしたらいいか御教授いただけますか? それで「同じ品物を複数の購入先から買っている場合 そのデータを知りたい」という目的は達成してるんじゃないの? 知ったデータをどうしたいのか書いてないから、この先どうするのかは誰もわかんないと思うわ。
関連するQ&A
- エクセルのマクロをスッキリさせたい
Sub 範囲指定() A下 = Range("A65536").End(xlUp).Row B下 = Range("B65536").End(xlUp).Row If A下 > B下 Then 仮下 = A下 Else 仮下 = B下 End If If 仮下 > 4 Then 下 = 仮下 Else 下 = 4 End If Range(Cells(4, 3), Cells(下, 3)).Select Range("C3").Copy.Paste End Sub もっと良い方法が有ると思うのですが、どうしたら良いでしょうか。
- ベストアンサー
- オフィス系ソフト
- 重複行を完全削除するエクセルのマクロ
Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 2).Value = Cells(ii, 2).Value _ And Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 5).Value = Cells(ii, 5).Value Then Dim iii As Byte iii = 1 Rows(ii).Delete Shift:=xlUp End If Next ii If iii = 1 Then Rows(i).Delete Shift:=xlUp iii = 0 Next i End Sub データーが下の表のように入っております。 A B C E F 1 1/26 a1234 fdsa 5000 C1 2 1/27 a4567 sdfa 4000 T2 3 1/28 a1234 dfsa 5000 C1 4 1/30 b4567 asdf 6600 A2 5 2/10 b4567 fsda 6600 A2 6 2/10 a1234 afds 5000 C1 B列、E列、F列が完全一致(重複1行目と3行目と6行目・4行目と5行目)で削除し結果的に2行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が3つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロ シート間の照合_上書き
マクロ初心者です。(エクセル2003使用) Sheet2の管理番号をSheet1の管理番号と照合し、同じであれば、数量など3項目を上書きするマクロを作ろうとしています。 (Sheet1:日々更新される元データ)全データ数約500件くらい A列 ,B, C, D, ・・・ 1行 管理番号,品名,注文数量,出荷数量,・・・ (Sheet2:上書きさせたいシート)全データ数約80件くらい G列 ,H, I J 9行 管理番号,品名,注文数量,出荷数量 ↑シート2にある管理番号をもとに数量などを照合&上書きをしたいのです。 ■シート1も2も行数は日々変動します。 ■シート1で、まれに同じ管理番号が2つ存在することがありますが、取り出したい数量などのデータは、常に1番目に照合する管理番号です。 Sub シート間照合と上書き() Dim i As Integer a = Worksheets("sheet1").Range("a65536").End(xlUp).Row For i = 2 To a If Worksheets("sheet1").Range("A2") = Worksheets("sheet2").Range("G9") Then Worksheets("sheet1").Cells(1, i) = Worksheets("sheet2").Range("G9") Worksheets("sheet1").Cells(2, i) = Worksheets("sheet2").Range("H9") Worksheets("sheet1").Cells(3, i) = Worksheets("sheet2").Range("I9") While Cells(1, i) <> "" i = i + 1 Wend End If Next End Sub ■上記 模索しながらマクロを作ってみたのですが、エラーにはならないのですが(F8)、まったく動きませんでした。 すみませんが、お力をかしてください。 よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- マクロでCOUNTIFを使いたい
マクロでCOUNTIFを使いたい COUNTIFを使いたく、下記のマクロを作成しました。 【転記元】A列の値が【転記先】A列には何回出てくるのか?を転記先C列に書き出す作業を したいのですが、提示したコードだと、★のC列全てに「1」が入ってしまいます。 ところが、★★の部分を下記のように書き替えると、正常にカウントされた値が入ります。 ent.Cells(i + 1, "C").Formula = Application.WorksheetFunction.CountIf(mst.Range("A2:A100"), ent.Cells(i + 1, "A")) なぜこうなるのか?原因が知りたくて頭を悩ませております。 お解りの方がいらっしゃればどうぞご指摘ください。 宜しくお願い致します。 ------------------------------------------------------------ 【転記元のシート】 A列 10 10 20 20 50 【転記先のシート】 A列 B列 C列 ←★このC列に結果を表示させたい 10 2 20 2 50 1 ------------------------------------------------------------ Sub カウントテスト() Dim ent As Worksheet, mst As Worksheet Dim i As Integer Dim lstcel As String Dim mstrange As Range Dim sach As Variant Set ent = Workbooks("転記先").ActiveSheet Set mst = Workbooks("転記元").ActiveSheet Set mstrange = mst.Range("A2:A100") i = 1 lstcel = mst.Cells(Rows.Count, "A").End(xlUp).Row sach = ent.Cells(i + 1, "A") For i = 1 To lstcel If mst.Cells(i + 1, "A") <> "" Then '↓★★ここの部分を書き替えるときちんとカウントされる ent.Cells(i + 1, "C").Formula = Application.WorksheetFunction.CountIf(mstrange, sach) End If Next i End Sub
- ベストアンサー
- その他MS Office製品
- Excelマクロ 複数条件一致データの抽出方法
お世話になります。 2個の条件に一致するものを別シートに抽出したいのですが、お知恵を貸してください。 Excelシートで下記のような表があります。 これをL列(品名)かつS列(品質)の条件に一致するデータで新しいシートを作成したいのですが、 その際に新しいシート名は"AA1"のようにしたいのです。 条件がC列(品名)だけであれば下記で動いたのですが…。 (データ) A列 入荷日 I列 品目コード L列 品名 S列 品質 V列 在庫 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 1/1・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・20 2/2・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・BB・・・・・・・・1・・・・・・・・・10 ※以下、最大100品目の行数10000程です。 ↓↓ (実行後希望) シート名 AA1 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 1/1・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・20 2/2・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・10 シート名 AA2 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 シート名 BB1 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 2/3・・・・01・・・・・・・BB・・・・・・・・1・・・・・・・・・10 Sub Sheet抽出() Dim i As Long, Lstrow As Long, myName As String Dim MySht As Worksheet, myFlg As Boolean Application.ScreenUpdating = False With Sheets("sheet1") '準備 For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row myName = .Cells(i, 9) 'シートの存在確認 For Each MySht In Worksheets If MySht.Name = myName Then myFlg = True '既にシート在り!! Sheets(myName).Range("a1") _ .CurrentRegion.Offset(1).ClearContents Exit For End If Next '新規シートの追加 If myFlg = False Then Worksheets.Add.Name = myName End If With Sheets(myName) .Range("A1") = "入荷日" .Range("I1") = "品名コード" .Range("L1") = "品名" .Range("S1") = "品質" .Range("V1") = "在庫" End With myFlg = False Next 'データの転記 For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row myName = .Cells(i, 9).Value .Range("A" & i & ":V" & i).Copy _ Sheets(myName).Cells(Rows.Count, 1).End(xlUp).Offset(1) With Sheets(myName) .Activate Lstrow = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(Rows.Count, 1).End(xlUp).Offset(1, 21) = "" .Cells(Rows.Count, 1).End(xlUp).Offset(1, 21) = _ "=SUM(v2:V" & Lstrow & ")" End With Next End With Sheets("Sheet1").Activate Application.ScreenUpdating = True End Sub 実行後希望のように抽出するには、どうすれば良いのでしょうか? よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- このマクロを訂正できますでしょうか?
private sub worksheet_change(byval Target as excel.range) dim h as range on error resume next for each h in application.intersect(target, range("C:C")) if h <> "" then cells(h.row, "A").formular1c1 = "=COUNTA(R1C[2]:RC[2])" cells(h.row, "B") = date else h.offset(0,-2).resize(1, 2).clearcontents end if next end sub このマクロはC列に入力すると、A列に番号、B列に入力した日付が入力されるマクロです。 現状の問題として、 (1)A列に計算式が入ってしまうこと (2)C3セルに品名という項目が入っているために、C4から品目を入力していく上で、最初の割り振られるNOが2番からになってしまう の2つの問題が生じています。これを解決するにはどのように訂正すればよいかご教授いただければ助かります。
- ベストアンサー
- オフィス系ソフト
- 重複行を完全削除するエクセルのマクロ
Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。
- ベストアンサー
- オフィス系ソフト
- エクセル VBA マクロについて
VBA初心者です。 Sub 記入() Range("H8", "J14").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H15", "J21").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H22", "J28").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("K13").Select End Sub こういうマクロを作り上手く作動しましたのでB列に日付を記入したいと思い Sub 日付() Range("("B" & Rows.Count).End(xlUp).Offset(1)","("C" & Rows.Count).End(xlUp).Offset(0, -1)").Value = Date End Sub このようなマクロを組みましたがエラーがでます。どなたか直して頂けませんか?よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセル2003マクロの再編集
Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Cells(行2, 3).Value = Abs(Sheets("Sheet2").Cells(行2, 3).Value) If Range("A" & 行1).Value = "BBBB1" Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub を編集したいのですが全然図りません ご指導お願いします 元データ AAAA5 9601 950 BBBB1 9660 150 ASAS9 9654 -50 AXCW5 9603 1375 以下の用にマクロで変換する用に出来たのですが 【1】 BBBB1だけではなくAAAA5も対処になったときの 追加方法です 元データは一切変更が出来ません ※フォントの変更も不可です 【2】 元データと変換後データがSheet1からSheet2になっていますが Sheet1の元は範囲はA1~C400で変換後をSheet1E1~G400にしたいのです AAAA5 9601 950 BBBB1-1 9660 150 BBBB1-2 9660 150 ASAS9 9654 50 AXCW5 9603 1375
- 締切済み
- Visual Basic
- Excelマクロのことで教えて下さい
初歩的なことですみません。 E列の値をF列に値を入れるために下記のマクロを組みました。 Sub test() Worksheets("Sheet1").Select Dim i As Long For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row Range("F2").Value = "=E2/1024/1024" Cells(i, 6).FillDown Range(Cells(2, 6), Cells(i, 6)).Copy Range("F2").PasteSpecial Paste:=xlValues Next i End Sub ところがF列に「値のみを貼り付け」をした時に、途中から同じ値のみがコピーされてしまい困っています。 (画像参照) うまく貼り付けることができるマクロをお教え下さい。 よろしくお願いいたします。
- ベストアンサー
- Excel(エクセル)
お礼
もうしわけないです また整理して質問させていただきますので そのときはよろしくおねがいします