Results of 1 - 1 of about 48864 for A�����������������������... (0.009 sec.)
- [[20211204184259]]
- #score: 1420
- @digest: c075e279b289dff71428c3f7aca7a602
- @id: 89808
- @mdate: 2021-12-05T00:45:24Z
- @size: 5287
- @type: text/plain
- #keywords: 社a1 (24347), mixnuts (13814), 社列 (10356), mydic (5834), 規約 (4979), aggregate (2244), 社d (2241), 社c (1540), す. (1442), 列a (1421), powerquery (1380), worksheets (1332), sheet1 (1256), ピン (1251), 数列 (1119), ubound (1075), rng (1070), keys (1060), 土) (982), preserve (961), scripting (960), 2021 (956), transpose (949), 例) (885), dictionary (865), iferror (857), ト2 (748), createobject (704), ト1 (682), 列b (681), value (641), ル= (589)
- 『1列のデータを規約ごとに複数列に分ける』（かず）
初めまして.質問があります. 「シート1」 A社 a1 A社 a2 A社 a3 A社 a4 B社 b1 B社 b2 B社 b3 C社 c1 D社 d1 D社 d2 D社 d3 D社 d4 ↓ 「シート2」 A社 B社 C社 D社 a1 b1 c1 d1 a2 b2 d2 a3 b3 d3 a4 d4 このように,シート1の2列にデータを並べた時にシート2に自動的に反映されるように関数を作りたいんですけど,どのように作ればよいでしょうか?関数は,シート2のa1などに入力できればと思っています.所々ずれていてみにくく申し訳ありません.シート2には,A社列にaのデータ,B社列にbのデータを入力したいです. もし関数が難しければ,マクロでも構いません.できる方は,よろしくお願いします. ＜ 使用 Excel:unknown、使用 OS:unknown ＞ ---- 関数やPowerQueryでも出来ると思いますが、不得手ですのでとりあえずマクロです。 そちらの回答は他の方の回答をお待ち下さい。 Sub Macro1() Dim dic As Object Dim ts As Worksheet Dim i As Long, j As Long Dim cnt As Long Dim arr Set dic = CreateObject("Scripting.Dictionary") With Worksheets("Sheet1") For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row On Error Resume Next dic.Add .Cells(i, 1).Value, "" On Error GoTo 0 Next i arr = Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp)).Value Set ts = Worksheets.Add(after:=Worksheets(Worksheets.Count)) ts.Cells(1, 1).Resize(, UBound(dic.keys) + 1).Value = dic.keys For i = 1 To UBound(dic.keys) + 1 cnt = 1 For j = 1 To UBound(arr) If arr(j, 1) = ts.Cells(1, i).Value Then cnt = cnt + 1 ts.Cells(cnt, i).Value = arr(j, 2) End If Next j Next i End With End Sub （MixNuts） 2021/12/04(土) 21:44 ---- シートの名前は、 With Worksheets("Sheet1") の"Sheet1" を実際のシート名に書き直して下さい。 例)シート1だとしたら、With Worksheets("シート1") の様に。 （MixNuts） 2021/12/04(土) 21:47 ---- 参考に Sub Test() Dim myDic As Object Dim v() As String, c As Range, d As Variant Dim key As String, itm As String, i As Long, rng As Range Set myDic = CreateObject("Scripting.Dictionary") With Worksheets("Sheet1") For Each c In .Range("A1", .Cells(Rows.Count, "A").End(xlUp)) key = Split(c.Value)(0) itm = Split(c.Value)(1) If myDic.Exists(key) Then v = myDic(key) i = UBound(v) + 1 ReDim Preserve v(i) Else i = 0 ReDim v(i) End If v(i) = itm myDic(key) = v Next End With Set rng = Worksheets("Sheet2").Range("A1") For Each d In myDic.keys rng.Value = d rng.Offset(1).Resize(UBound(myDic(d)) + 1).Value = Application.Transpose(myDic(d)) Set rng = rng.Offset(, 1) Next End Sub （ピンク） 2021/12/04(土) 22:29 ---- >1列のデータを規約ごとに複数列に分ける A列1列に "A社 a1" と記述しているのではなく A列 B列 A社 a1 なら私の早とちりで間違った回答をしてしまったようです。(;^_^A 今日は絶不調なので寝ます。 （ピンク） 2021/12/04(土) 22:54 ---- A列 B列 A社 a1 の方も回答しておきます。 Sub Test2() Dim myDic As Object Dim v() As String, c As Range, d As Variant Dim i As Long, rng As Range Set myDic = CreateObject("Scripting.Dictionary") With Worksheets("Sheet1") For Each c In .Range("A1", .Cells(Rows.Count, "A").End(xlUp)) If myDic.Exists(c.Value) Then v = myDic(c.Value) i = UBound(v) + 1 ReDim Preserve v(i) Else i = 0 ReDim v(i) End If v(i) = c.Offset(, 1).Value myDic(c.Value) = v Next End With Set rng = Worksheets("Sheet2").Range("A1") For Each d In myDic.keys rng.Value = d rng.Offset(1).Resize(UBound(myDic(d)) + 1).Value = Application.Transpose(myDic(d)) Set rng = rng.Offset(, 1) Next End Sub （ピンク） 2021/12/04(土) 23:00 ---- A1: =TRANSPOSE(FILTER(UNIQUE(Sheet1!A:A),UNIQUE(Sheet1!A:A)<>"")) A2: =IF(A$1<>"",FILTER(Sheet1!$B:$B,Sheet1!$A:$A=A$1),"") （マナ） 2021/12/04(土) 23:07 ---- おはようございます。 365難民の私が何を思ったのか証拠にもなく思い付きで書いてみました。(^^; A1に↓として右にフィル =IFERROR(INDEX(Sheet1!$A$1:$A$12, AGGREGATE(15,6,(MATCH(Sheet1!$A$1:$A$12,Sheet1!$A$1:$A$12,0)=ROW($A$1:$A$12))/(MATCH(Sheet1!$A$1:$A$12,Sheet1!$A$1:$A$12,0)=ROW($A$1:$A$12))*ROW($A$1:$A$12),COLUMN(A1))),"") A2に↓として右に下にフィル =IFERROR(INDEX(Sheet1!$B$1:$B$12, AGGREGATE(15,6,(((Sheet1!$A$1:$A$12=A$1)*ROW($A$1:$A$12))/((Sheet1!$A$1:$A$12=A$1)*ROW($A$1:$A$12)))*ROW($A$1:$A$12),ROW(A1))),"") （SoulMan） 2021/12/05(日) 08:06 ---- EXCEL2010(?)以降として書き込みます。 Sheet2の1行目に会社名が入力されているとします。 A2: =IFERROR(INDEX(Sheet1!$B$1:$B$12,AGGREGATE(15,6,ROW($A$1:$A$12)/(Sheet1!$A$1:$A$12=A$1),ROW(A1))),"") 右と下にコピーします。 （メジロ） 2021/12/05(日) 09:45... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202112/20211204184259.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97068 documents and 608366 words.
訪問者：