Results of 1 - 1 of about 48855 for A�����������������������... (0.010 sec.)
- [[20150114141815]]
- #score: 1420
- @digest: efdf30aba48120972e796cfa383b07b9
- @id: 67018
- @mdate: 2015-01-16T04:30:26Z
- @size: 12133
- @type: text/plain
- #keywords: 察10 (118093), 視察 (112894), 議3 (69263), 修5 (61991), 張名 (61991), 京視 (61991), 名旅 (56859), 費旅 (50781), 旅費 (47905), 屋会 (46493), sarara (38319), 阪研 (30995), 水視 (30995), 安部 (29484), 村福 (29295), 島空 (29072), 号月 (28771), 水東 (28021), 中清 (24940), 清水 (17580), 日氏 (16939), 研修 (15031), 福島 (13382), 出張 (11413), 先出 (11258), 会議 (10805), 中村 (10772), ans (10667), 部空 (10263), 本田 (10222), 山本 (6718), 名出 (6156)
- 『並び替えについて』（sarara）
並び替えについて教えてください。 SHeet1に下記のような一覧表があります。 番号 氏名1 氏名2 氏名3 出張名 旅費 旅費 旅費 1 山本 田中 清水 視察 10,000 10,000 10,000 2 安部 空白 空白 研修 5,000 0 0 3 中村 福島 空白 会議 3,000 3,000 0 ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ 氏名が3列に渡っているのを、Sheet2へ下記のように氏名を1列にまとめたいと考えています。 空白のセルは詰めて、まとめたいのですが、自動記録やVBAで一発で並び替える方法はありますか? 番号 氏名 出張名 旅費 1 山本 視察 10,000 1 田中 視察 10,000 1 清水 視察 10,000 2 安部 研修 5,000 3 中村 会議 3,000 3 福島 会議 3,000 ・ ・ ・ ・ ・ ・ ・ ・ ＜ 使用 Excel:Excel2007、使用 OS:Windows7 ＞ ---- 単純にループ! Sub aaa() Dim a Dim ans Dim i As Long Dim j As Long Dim n As Long n = 2 a = Range("A1").CurrentRegion.Value ReDim ans(1 To UBound(a, 1) * 3, 1 To 4) ans(1, 1) = a(1, 1) ans(1, 2) = Left(a(1, 2), 2) ans(1, 3) = a(1, 5) ans(1, 4) = a(1, 6) For i = 2 To UBound(a, 1) For j = 2 To 4 If a(i, j) <> "" Then ans(n, 1) = a(i, 1) ans(n, 2) = a(i, j) ans(n, 3) = a(i, 5) ans(n, 4) = a(i, j + 4) n = n + 1 Else Exit For End If Next j Next i With Sheets.Add .Range("A1").Resize(UBound(ans, 1), 4).Value = ans End With End Sub （稲葉） 2015/01/14(水) 15:50 ---- 稲葉様 ありがとうございました! うまく並び替え出来ました^^ （sarara） 2015/01/14(水) 22:40 ---- すみません。 番号と氏名の間に月日を入れた場合の並び替えを教えていただけないでしょうか。 番号 月日 氏名1 氏名2 氏名3 出張名 旅費 旅費 旅費 1 4/1 山本 田中 清水 視察 10,000 10,000 10,000 2 5/1 安部 空白 空白 研修 5,000 0 0 3 6/1 中村 福島 空白 会議 3,000 3,000 0 ↓ 番号 月日 氏名 出張名 旅費 1 4/1 山本 視察 10,000 1 4/1 田中 視察 10,000 1 4/1 清水 視察 10,000 2 5/1 安部 研修 5,000 3 6/1 中村 会議 3,000 3 6/1 福島 会議 3,000 （sarara） 2015/01/14(水) 23:10 ---- 簡単なループ処理です まずご自身で書き換えてみてください そうすれば仕様変更にも自分で対応できるようになりますよ! 解らなければ、なにをどうしたけど、求める結果を得られなかったなど し質問していただければ、お答えいたします （稲葉） 2015/01/15(木) 07:10 ---- コードの意味が分からなかったので、私なりに調べましたが 今ひとつ分かりませんでした（泣） 稲葉さんが書いてくれたそれぞれのコードがどういう動作をし、 どういう結果になるのかが分かれば、多少は分かると思うのですが・・ （sarara） 2015/01/15(木) 13:40 ---- Range("A1").CurrentRegion.Value A1を選択して、Ctrl+Shift+: を押したときの動作です。 iは行のループ jは列のループを表しています。 Sub aaa() Dim a Dim ans Dim i As Long Dim j As Long Dim n As Long n = 2 a = Range("A1").CurrentRegion.Value ReDim ans(1 To UBound(a, 1) * 3, 1 To 5) ans(1, 1) = a(1, 1) ans(1, 2) = a(1, 2) ans(1, 3) = Left(a(1, 3), 2) ans(1, 4) = a(1, 6) ans(1, 5) = a(1, 7) For i = 2 To UBound(a, 1) For j = 3 To 5 If a(i, j) <> "" Then ans(n, 1) = a(i, 1) ans(n, 2) = a(i, 2) ans(n, 3) = a(i, j) ans(n, 4) = a(i, 6) ans(n, 5) = a(i, j + 4) n = n + 1 Else Exit For End If Next j Next i With Sheets.Add .Range("A1").Resize(UBound(ans, 1), 5).Value = ans End With End Sub （稲葉） 2015/01/15(木) 14:06 ---- 項目をもう一つ増やしたく、いろいろとコードをいじりましたが、うまくいきませんでした・・・ 再度、ご教授いただけないでしょうか・・ 番号 月日 氏名1 氏名2 氏名3 用務先 出張名 旅費 旅費 旅費 1 4/1 山本 田中 清水 東京 視察 10,000 10,000 10,000 2 5/1 安部 空白 空白 大阪 研修 5,000 0 0 3 6/1 中村 福島 空白 名古屋 会議 3,000 3,000 0 番号 月日 氏名 出張先 出張名 旅費 1 4/1 山本 東京 視察 10,000 1 4/1 田中 東京 視察 10,000 1 4/1 清水 東京 視察 10,000 2 5/1 安部 大阪 研修 5,000 3 6/1 中村 名古屋 会議 3,000 3 6/1 福島 名古屋 会議 3,000 Sub aaa() Dim a Dim ans Dim i As Long Dim j As Long Dim n As Long n = 2 a = Range("A1").CurrentRegion.Value ReDim ans(1 To UBound(a, 1) * 3, 1 To 6) ans(1, 1) = a(1, 1) ans(1, 2) = a(1, 2) ans(1, 3) = Left(a(1, 3), 2) ans(1, 4) = a(1, 6) ans(1, 5) = a(1, 7) ans(1, 6) = a(1, 8) For i = 2 To UBound(a, 1) For j = 3 To 6 If a(i, j) <> "" Then ans(n, 1) = a(i, 1) ans(n, 2) = a(i, 2) ans(n, 3) = a(i, j) ans(n, 4) = a(i, 6) ans(n, 5) = a(i, j + 4) ans(n, 6) = a(i, 7) n = n + 1 Else Exit For End If Next j Next i With Sheets.Add .Range("A1").Resize(UBound(ans, 1), 6).Value = ans End With End Sub （sarara） 2015/01/15(木) 16:34 ---- 仕様変更がないように、そちらを固めてから再度質問してください。 （稲葉） 2015/01/16(金) 08:28 ---- 稲葉様 何度もすみません。 仕様としてはこれが最終の形になります。 コードを見ながら勉強したいと思います。 よろしくお願いいたします。 番号 月日 氏名1 氏名2 氏名3 出張先 出張名 旅費 旅費 旅費 1 4/1 山本 田中 清水 東京 視察 10,000 10,000 10,000 2 5/1 安部 空白 空白 大阪 研修 5,000 0 0 3 6/1 中村 福島 空白 名古屋 会議 3,000 3,000 0 ↓ 番号 月日 氏名 出張先 出張名 旅費 1 4/1 山本 東京 視察 10,000 1 4/1 田中 東京 視察 10,000 1 4/1 清水 東京 視察 10,000 2 5/1 安部 大阪 研修 5,000 3 6/1 中村 名古屋 会議 3,000 3 6/1 福島 名古屋 会議 3,000 （sarara） 2015/01/16(金) 09:33 ---- Sub aaa() Dim a Dim ans Dim i As Long Dim j As Long Dim n As Long n = 2 a = Range("A1").CurrentRegion.Value ReDim ans(1 To UBound(a, 1) * 3, 1 To 6) ans(1, 1) = a(1, 1) ans(1, 2) = a(1, 2) ans(1, 3) = Left(a(1, 3), 2) ans(1, 4) = a(1, 6) ans(1, 5) = a(1, 7) ans(1, 6) = a(1, 8) For i = 2 To UBound(a, 1) For j = 3 To 5 If a(i, j) <> "" Then ans(n, 1) = a(i, 1) ans(n, 2) = a(i, 2) ans(n, 3) = a(i, j) ans(n, 4) = a(i, 6) ans(n, 5) = a(i, 7) ans(n, 6) = a(i, j + 5) n = n + 1 Else Exit For End If Next j Next i With Sheets.Add .Range("A1").Resize(UBound(ans, 1), 6).Value = ans End With End Sub （稲葉） 2015/01/16(金) 09:48 ---- 稲葉様 本当にありがとうございました! 助かりましたm(_ _)m これを機にVBAの勉強をしたいと思います。 （sarara） 2015/01/16(金) 09:53 ---- こんにちは 解決しちゃいましたけど、手作業的な処理をVBAで書く場合のコードです。 Sub test() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim i As Long Dim j As Long Dim r As Range Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") Application.ScreenUpdating = False sh2.UsedRange.Delete sh1.Range("H1").Value = "旅費1" sh1.Range("I1").Value = "旅費2" sh1.Range("J1").Value = "旅費3" Set r = sh1.Range("A1").CurrentRegion j = 1 For i = 1 To 3 sh1.Range("A1:B1").Copy sh2.Range("A" & j) sh1.Range("F1:G1").Copy sh2.Range("D" & j) sh1.Cells(i + 2).Copy sh2.Range("C" & j) sh1.Cells(1, i + 7).Copy sh2.Range("F" & j) r.AdvancedFilter xlFilterCopy, , sh2.Range("A" & j).Resize(, 6) If i > 1 Then sh2.Range("A" & j).Resize(, 6).Delete xlShiftUp End If j = sh2.Range("A1").CurrentRegion.Rows.Count + 1 Next sh1.Range("H1:J1").Value = "旅費" sh2.Range("C1").Value = "氏名" sh2.Range("F1").Value = "旅費" On Error Resume Next sh2.Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 sh2.Range("A1").CurrentRegion.Sort _ Key1:=sh2.Range("A1"), Order1:=xlAscending, _ Key1:=sh2.Range("B1"), Order1:=xlAscending, Header:=xlYes Application.ScreenUpdating = True End Sub （ウッシ） 2015/01/16(金) 10:19 ---- ウッシ様 ありがとうございます。 皆さんすごいですね! パッと解決されてしまうので、職場にいてくれたらなあといつも思います。 またよろしくお願いいたします。 （sarara） 2015/01/16(金) 12:16 ---- なるほど 手作業をVBAに表すって方法も面白いですね! Sub bbb() Dim r As Range Dim LR As Long Dim WS As Worksheet Set WS = ActiveSheet With Sheets.Add WS.Range("A1").CurrentRegion.Copy .Range("A1") Set r = .Range("J2", .Range("A" & Rows.Count).End(xlUp)) r.Copy .Range("A" & Rows.Count).End(xlUp).Offset(1) r.Copy .Range("A" & Rows.Count).End(xlUp).Offset(1) .Range("J2", .Range("A" & Rows.Count).End(xlUp)).Sort .Range("A2"), xlAscending Set r = .Range("K2:L" & .Range("A" & Rows.Count).End(xlUp).Row) r.Offset(, 0).Resize(, 1).Formula = "=SUBSTITUTE(INDEX(C2:E2,,MOD(ROW()+1,3)+1),""0"","""")" r.Offset(, 1).Resize(, 1).Formula = "=INDEX(H2:J2,,MOD(ROW()+1,3)+1)" r.Value = r.Value .Range("L2", .Range("A" & Rows.Count).End(xlUp)).Sort .Range("K2"), xlAscending .Range(.Range("A" & Rows.Count).End(xlUp), .Range("K" & Rows.Count).End(xlUp).Offset(1)).EntireRow.Delete LR = .Range("A" & Rows.Count).End(xlUp).Row .Range("C2:C" & LR).Value = .Range("K2:K" & LR).Value .Range("H2:H" & LR).Value = .Range("L2:L" & LR).Value .Range("I:L").Delete .Range("D:E").Delete .Range("J2", .Range("A" & Rows.Count).End(xlUp)).Sort .Range("A2"), xlAscending End With End Sub 自分には余計難しくなりました・・・ Deleteの処理とかずれる （稲葉） 2015/01/16(金) 13:30... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201501/20150114141815.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608267 words.
訪問者：