質問: 同じ文字列を抽出して新規シート作成 a列~e列までデータが入力されています。 e列は所々、空白セルがあります。 1行目は見出しです。 元データのa列の中で同じ文字列を探して 見出しと該当するa~e列の行を新規シートとして作成。 その際、シート名はa列の文字列。 a列の文字列が2つ以上見つからなくても a列の文字列を新規シートにする。 最終行は常に変動します。 元データ (b列~e列は割愛) a-1 名前 a-2 鈴木 a-3 佐藤 a-4 鈴木 a-5 山田 a-6 佐藤 新規シート名 「鈴木」 a-1 名前 a-2 鈴木 a-3鈴木 新規シート名 「佐藤」 a-1 名前 a-2 佐藤 a-3 佐藤 新規シート名 「山田」 a-1 名前 a-2 山田 上記の事をマクロで実行させたいです。 ご指南の程、宜しくお願い致します。 エクセル2013
回答: こんばんは! 一例です。 元データはsheet1にあり、sheet1の1行目は項目行で データは2行目以降にあるとします。 標準モジュールです。 sub sample1() dim i as long, k as long, lastrow as long, cnt as long, str as string dim ws as worksheet, ws2 as worksheet, myflg as boolean application.screenupdating = false worksheets.add after:=worksheets(worksheets.count) set ws = worksheets(worksheets.count) with worksheets("sheet1") lastrow = .cells(rows.count, "a").end(xlup).row .range("a:a").insert .range("a1") = .name with range(.cells(2, "a"), .cells(lastrow, "a")) .formula = "=if(isnumber(find(""-"",asc(b2))),b3,b2)" .value = .value end with .range("a:a").advancedfilter action:=xlfiltercopy, copytorange:=ws.range("a1"), unique:=true ws.range("a:a").replace what:="名前", replacement:="", lookat:=xlwhole ws.range("a:a").specialcells(xlcelltypeblanks).delete shift:=xlup for i = 2 to ws.cells(rows.count, "a").end(xlup).row .range("a1").autofilter field:=1, criteria1:=ws.cells(i, "a"), operator:=xlor, criteria2:="名前" for k = 2 to worksheets.count if worksheets(k).name = ws.cells(i, "a") then myflg = true exit for end if next k if myflg = false then str = ws.cells(i, "a") worksheets.add after:=worksheets(ws.cells(i - 1, "a").text) activesheet.name = ws.cells(i, "a") end if set ws2 = worksheets(ws.cells(i, "a").text) ws2.cells.clear range(.cells(1, "b"), .cells(lastrow, "f")).specialcells(xlcelltypevisible).copy _ ws2.range("a1") for k = 2 to ws2.cells(rows.count, "a").end(xlup).row if instr(strconv(ws2.cells(k, "a"), vbnarrow), "-") > 0 then cnt = cnt + 1 ws2.cells(k, "a") = "a-" & cnt end if next k myflg = false cnt = 0 next i .autofiltermode = false .range("a:a").delete application.displayalerts = false ws.delete application.displayalerts = true end with application.screenupdating = true end sub じっくり考えればもっと簡単になるかもしれませんが、 とりあえずはこの程度で・・・m(_ _)m