• 締切済み

エクセルのマクロについてです

あるソフトから出力したテキストデータを エクセルに取り込んで入庫台帳をつくっています。 A列～I列まで項目があり １行目に項目名があります A２　日付　B2　購入先　C２品名 D2　包装の数　E2～G２　今回関係ない項目 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列でかけて「２以上」を表示させるところまでなんとかできたのですが それから先をどうしたらいいか 御教授いただけますか？ 　

  • ennkai
  • お礼率54% (284/525)

みんなの回答

  • error123
  • ベストアンサー率21% (54/247)
回答No.1

> それから先をどうしたらいいか御教授いただけますか？ それで「同じ品物を複数の購入先から買っている場合　そのデータを知りたい」という目的は達成してるんじゃないの？ 知ったデータをどうしたいのか書いてないから、この先どうするのかは誰もわかんないと思うわ。

ennkai
質問者

お礼

もうしわけないです また整理して質問させていただきますので そのときはよろしくおねがいします

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連する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 データーが下の表のように入っております。 　　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｅ　　　　Ｆ １　　1/26　　a1234　　fdsa　　5000　　Ｃ1 ２　　1/27　　a4567　　sdfa　　4000　　Ｔ2 ３　　1/28　　a1234　　dfsa　　5000　　Ｃ1 ４　　1/30　　b4567　　asdf　　6600　　Ａ2 ５　　2/10　　b4567　　fsda　　6600　　Ａ2 ６　　2/10　　a1234　　afds　　5000　　Ｃ1 Ｂ列、Ｅ列、Ｆ列が完全一致（重複１行目と３行目と６行目・４行目と５行目）で削除し結果的に２行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が３つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。

  • エクセルマクロ　シート間の照合＿上書き

    マクロ初心者です。（エクセル２００３使用） Sheet2の管理番号をSheet1の管理番号と照合し、同じであれば、数量など３項目を上書きするマクロを作ろうとしています。 （Sheet1：日々更新される元データ）全データ数約500件くらい Ａ列　　　,Ｂ,　　Ｃ,　　Ｄ,　　　・・・ １行　管理番号,品名,注文数量,出荷数量,・・・ （Sheet2：上書きさせたいシート）全データ数約80件くらい Ｇ列　　　,Ｈ,　　Ｉ　　　Ｊ　　　　　 ９行　管理番号,品名,注文数量,出荷数量 ↑シート２にある管理番号をもとに数量などを照合＆上書きをしたいのです。 ■シート１も２も行数は日々変動します。 ■シート１で、まれに同じ管理番号が２つ存在することがありますが、取り出したい数量などのデータは、常に１番目に照合する管理番号です。 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）、まったく動きませんでした。 すみませんが、お力をかしてください。 よろしくお願いいたします。

  • マクロで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

  • 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 & ":Ｖ" & 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 実行後希望のように抽出するには、どうすれば良いのでしょうか？ よろしくお願いいたします。

  • このマクロを訂正できますでしょうか？

    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)C３セルに品名という項目が入っているために、C４から品目を入力していく上で、最初の割り振られるNOが２番からになってしまう の２つの問題が生じています。これを解決するにはどのように訂正すればよいかご教授いただければ助かります。

  • 重複行を完全削除するエクセルのマクロ

    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 マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 ４列目と１３列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。

  • エクセル　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

  • 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列に「値のみを貼り付け」をした時に、途中から同じ値のみがコピーされてしまい困っています。 （画像参照） うまく貼り付けることができるマクロをお教え下さい。 よろしくお願いいたします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する