• 締切済み

エクセルvbaで同姓同名の抽出方法について

tsubu-yukiの回答

回答No.3

色々と考えさせられるモノですねぇ・・ ご提示のソレは何を参考に書かれたものなのでしょう。 なかなか見かけない文法ばかりで、 > どこをどう直せばいいのか 私も解りません(笑)。 根本的に考え直したらいかがか？としか言いようがありません。 ご自身がやりたい処理をまとめませんか？ まぁ、マクロ以前の問題だと思うのです。 私の予想に過ぎないのですが、 「フィルタをかけて、結果をコピー、別シートに貼り付け」 の処理と大差ないのではないでしょうか。 だとしたら、それを「マクロの記録」してやれば 大体いい感じのコードを書けます。 あとはご自身の使いやすくカスタマイズしてやればいいだけです。 > 1000人越えの情報があり、 >同姓同名が何人かいて、フィルタをかけても > フィルタ結果後から目的の人を見つけるのが大変 1000人を超える「同姓同名」が居るではないですよね？ 「同姓」に限っても多くて十数名でしょう。 エクセルを最大化しておけば３０～５０行は画面に表示されますから 普通にフィルタをかければスクロールせずに１画面に十分納まるのでは？ 見た感じ、 ・みょうじ（昇順） ・社員コード順（昇順） にでも並んでいるんですかねぇ。 これを変えてみたらいかがですか？ 考えやすいのは ・みょうじ（昇順） ・なまえ（昇順） ・※部署（昇順） でしょうか。 フィルタの結果が何件あろうが名前が五十音で並び、 さらに部署ごとに並ぶのですから、 ここにフィルタを掛ければ、さらに探しやすくなるのでは？ これで探せない、とおっしゃるのであれば、それはそれ、 「国語辞書、引けます？」という疑問を禁じ得ないところです。

この回答がついた質問に戻る
回答 全件
＞フィルタをかけてもフィルタ結果後から目的の人を見つけるのが大変なんで…
こんにちは。 落ち着いて、状況を整理し、何が必要か、要点は何か、 ご…
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • エクセル　VBAで

    変動する数値が、セル A1に入る状況で、 該当シートに Private Sub Worksheet_Change(ByVal Target As Range) If Range("A1").Value = 1 Then Range("C62").Value = "○" ElseIf Range("A1").Value = 2 Then Range("C62:C63").Value = "○" ElseIf Range("A1").Value = 3 Then Range("C62:C64").Value = "○" ElseIf Range("A1").Value = 4 Then Range("C62:C65").Value = "○" ElseIf Range("A1").Value = 5 Then Range("C62:C66").Value = "○" ElseIf Range("A1").Value = 6 Then Range("C62:C67").Value = "○" ElseIf Range("A1").Value = 7 Then Range("C62:C68").Value = "○" ElseIf Range("A1").Value = 8 Then Range("C62:C69").Value = "○" ElseIf Range("A1").Value = 9 Then Range("C62:C70").Value = "○" ElseIf Range("A1").Value = 10 Then Range("C62:C71").Value = "○" ElseIf Range("A1").Value = 11 Then Range("C62:C72").Value = "○" ElseIf Range("A1").Value = 12 Then Range("C62:C73").Value = "○" ElseIf Range("A1").Value = 13 Then Range("C62:C74").Value = "○" ElseIf Range("A1").Value = 14 Then Range("C62:C75").Value = "○" ElseIf Range("A1").Value = 15 Then Range("C62:C76").Value = "○" End If End Sub と言ったマクロを記述しましたが、 動作がどうにも重くて困っています。 一度、プレビューをした後は特に遅くなります。 何か良い解決方法はありますでしょうか？

  • ExcelのVBAで複数行を転記する方法について

    いつもお世話になります。YouTubeで変数を使わない複数行を纏めて転記する内容を見ました。”C10～H12セルの値をL10～Q12セルへ出力する" <Range("L10:Q12")：Value=Range("C10:H12")：Value>　で一行で纏められる例題が出ていました。そこで私が作っている変数入りの複数行を一行で書く方法を教えてください。 ””””私の作ったプログラムです””””” Sub 領収証班別() '出力行を設定する変数の定義 Dim CtrRow '繰返し処理用の変数定義 Dim i '------------------------------------------------------------------------------ '出力行の開始位置を設定 CtrRow = 2 '2行目から62行目まで繰り返す For i = 2 To 62 'B(領収証の班別)に指定班名が合致しているか判定する If Worksheets("領収証").Range("B" & i).Value = "南１班" Then 'Worksheets("領収証班別").Range("A" & CtrRow).Value = Worksheets("領収証").Range("A" & i).Value 'Worksheets("領収証班別").Range("B" & CtrRow).Value = Worksheets("領収証").Range("B" & i).Value 'Worksheets("領収証班別").Range("C" & CtrRow).Value = Worksheets("領収証").Range("C" & i).Value 'Worksheets("領収証班別").Range("D" & CtrRow).Value = Worksheets("領収証").Range("D" & i).Value 'Worksheets("領収証班別").Range("E" & CtrRow).Value = Worksheets("領収証").Range("E" & i).Value '１行出力したため、出力行の位置を+1にする CtrRow = CtrRow + 1 '判定処理の終了 End If '繰り返し処理の終了 Next i '------------------------------------------------------------------------------ '出力行の開始位置を設定 CtrRow = 24 '2行目から62行目まで繰り返す For i = 2 To 62 　　　　： 　　　　： 次から次へと続きます。 と云うようなプログラムの中で 'Worksheets("領収証班別").Range("A" & CtrRow).Value = Worksheets("領収証").Range("A" & i).Value 'Worksheets("領収証班別").Range("B" & CtrRow).Value = Worksheets("領収証").Range("B" & i).Value 'Worksheets("領収証班別").Range("C" & CtrRow).Value = Worksheets("領収証").Range("C" & i).Value 'Worksheets("領収証班別").Range("D" & CtrRow).Value = Worksheets("領収証").Range("D" & i).Value 'Worksheets("領収証班別").Range("E" & CtrRow).Value = Worksheets("領収証").Range("E" & i).Value この複数行をYouTubeの例題の様に一行に纏めて書く方法はありませんか？このプログラムも、よちよち歩きで作ったものです（初心者です）よろしくお願いいたします。

  • エクセルVBA抽出がうまく出来ません

    エクセル2013VBA初心者です。 入力シートからＤＢシートへ、ＤＢシートから印刷シートへのデータ転記と印刷、入力内容のクリアまでは出来るようになりました。 ＤＢシートの検索を行い、記録内容を入力シートに転記する抽出を行いたいのですが、下記構文を書いたところで問題が発生しました。 If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then　 でとまります。メッセージは　‘Range’メソッドは失敗しました：‘Workshieet’オブジェクトというものです。 やろうとしていることは、入力シートに設けた“E12”と”G12”の二つの検索項目をキーにDBシートの行を特定し、この行の内容を入力シートに反映しようということです。 入力シートの検索項目“E12”、 ”G12”はそれぞれDBシートのA列、B列に格納されている項目で、年度と連番です。サンプルとして入力シート"C5"に抽出しようとしているDBシートD列は申請者名です。 恐れ入りますがよろしくご教示頂きたく、お願い申し上げます。 Sub DBシートから力情報を抽出する () Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim i As Long Dim j As Long Dim k As Long Set Sh1 = Worksheets("入力") Set Sh2 = Worksheets("DB") j = Sh1.Range("E12").Value k = Sh1.Range("G12").Value With Sh2 For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then Sh1.Range("C5").Value = Sh2.Range("D & i").Value End If Next 　End With End Sub

  • コンボボックスの記述の簡素化

    下記の記述でコンボボックスにデーターを表示するようにしたのですが 大量に記述が必要になります。 もっと簡素化できないでしょうか。 よろしくお願いします。 If Worksheets("Sheet2").Range("C3").Value = Worksheets("Sheet2").Range("C2").Value Then 品名リスト.RowSource = "Sheet2!D3：D18" ElseIf Worksheets("Sheet2").Range("C4").Value = Worksheets("Sheet2").Range("C2").Value Then 品名リスト.RowSource = "Sheet2!E3：E20" ―　―　省略　―　― ElseIf Worksheets("Sheet2").Range("C20").Value = Worksheets("Sheet2").Range("C2").Value Then 品名リスト.RowSource = "Sheet2!U3：U20" ElseIf Worksheets("Sheet2").Range("C21").Value = Worksheets("Sheet2").Range("C2").Value Then 品名リスト.RowSource = "Sheet2!V3：V20"

  • VBAでの入力

    A1～D5に自動的に順番にデータを入力したいです。 A1→B1→C1→D1→A2→B2→C2→D2→A3・・・ といった感じです。 If range("A1").Value = "" Then 　range("A1").Value=○ ElseIf range("A1").Value <> "" Then 　range("B2").Value = ○○ ・・・ のようにたくさんIf文を書くしかないのでしょうか。

  • エクセルVBAについて

    エクセルVBA初心者で、勉強中の者です。 添付画像のような時間のグラフのようなものを作りたいと思っています。 ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ Sub 時間グラフ作成() If Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:05") Then Worksheets("(2)(2)(2)(2)").Range("I2").Select 　With Selection.Interior 　　.ColorIndex = 8 　　.Pattern = xlSolid 　End With Elseif Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:10") Then Worksheets("(2)(2)(2)(2)").Range("J2").Select 　With Selection.Interior 　　.ColorIndex = 8 　　.Pattern = xlSolid 　End With 　・ 　・　 　・ End If End Sub 'それから、終了の時間を入れて、開始から終了までの間を塗りつぶす。 ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ 以上のように作成しようと考えていましたが、いざやろうとすると 1行に対してあまりにも膨大な記述をしなくてはならないことに 気がつきました(一月分ともなると恐ろしいです・・・)・・・。 もっと効率的な方法はあるものでしょうか？ よろしくお願いいたします。

  • エクセルVBAについて

    前回質問させていただきました件の追加機能になります。以前質問させていただきましたマクロが下記のものです。 Sub TESTa() Dim A As Long Dim B As Long Dim C As Long Dim D As Long Dim E As Long Dim F As Long '表の行数を調べる A = Worksheets("sheet1").Range("C65536").End(xlUp).Row - 1 For C = 1 To A For B = 4 To 7 'Sheet1のデータをSheet2に複写する Worksheets("Sheet2").Cells(B - 3 + D, 15) = Worksheets("Sheet1").Cells(C + 1, 1) Worksheets("Sheet2").Cells(B - 3 + D, 6) = Worksheets("Sheet1").Cells(C + 1, B) Worksheets("Sheet2").Cells(B - 3 + D, 14) = Worksheets("Sheet1").Cells(C + 1, 3) Worksheets("Sheet2").Cells(B - 3 + D, 10) = Worksheets("Sheet1").Cells(1, B) Worksheets("Sheet2").Cells(B - 3 + D, 13) = Worksheets("Sheet1").Cells(C + 1, 2) Next D = C * 4 Next 'Sheet2の表の行数を調べる Sheets("Sheet2").Select E = Worksheets("sheet2").Range("F65536").End(xlUp).Row '0欄の確認 For F = E To 1 Step -1 If Worksheets("Sheet2").Cells(F, 6) = 0 Then '0の場合は行を削除する Cells(F, 1).EntireRow.Delete End If Next End Sub カウントするとデータ個数がSheet1で約１２０件になりSheet2においては、４倍になりますので約４８０件になります。 そこで　Sheet1において１２件ごとに、Sheet2,3,4...としたいのです。 Sh1 NO.1～12がSheet2 Sh1 NO.13～24がSheet3 ... 10枚のシートにしたいのですが、このマクロにどのような命令を加えればよろしいでしょうか？ お手数ですがよろしくお願いいたします。

  • エクセルVBA

    よろしくお願いいたします。 エクセルのVBAですが、下記のコードを実行すると処理が遅いです。処理が早くなるコード教えてください。 よろしくお願いいたします。 Sub Macro3() Dim aa As Variant Dim i As Variant Application.ScreenUpdating = False Range("A14:i46").Select aa = ActiveSheet.Name ActiveWorkbook.Worksheets(aa).Sort.SortFields.Clear ActiveWorkbook.Worksheets(aa).Sort.SortFields.Add Key:=Range("B15:B46"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets(aa).Sort.SortFields.Add Key:=Range("C15:C46"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets(aa).Sort .SetRange Range("A14:i46") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With For i = 0 To 31 Cells(15 + i, 7).Select If Selection.Value = 0 Then Selection.EntireRow.Hidden = True End If Next i Range("A1").Select Application.ScreenUpdating = True End Sub

  • エクセルマクロ　if文を繰り返したい

    マクロ初心者です。 以下のようなマクロを作ったのですが、 これをE34まで繰り返しの処理をしたいです。 どこにどんな文章を挟んでいいのかわかりません。 Sub けいさん() If Workbooks("日報.xls").Worksheets("お手本").Range("O22") = "A" Then Workbooks("test.xls").Worksheets("II-1(1)").Range("E11") = "" ElseIf Workbooks("日報.xls").Worksheets("お手本").Range("O22") = "B" Then Workbooks("test.xls").Worksheets("II-1(1)").Range("E11") = "" ElseIf Workbooks("日報.xls").Worksheets("お手本").Range("O22") = "D" Then Workbooks("test.xls").Worksheets("II-1(1)").Range("E11") = "" ElseIf Workbooks("日報.xls").Worksheets("お手本").Range("C22") = "" Then Workbooks("test.xls").Worksheets("II-1(1)").Range("E11") = "" Else Workbooks("日報.xls").Worksheets("お手本").Range("C22").Copy Workbooks("test.xls").Worksheets("II-1(1)").Range("E11").PasteSpecial End If End Sub

  • Excel　VBA　グラフ作成のときのエラー

    VBA初心者です。Excel2003を使っています。 Sheet1に作りたいグラフがあります。 データは下記のとおりです。 ActiveChart.SeriesCollection(1).Name = Cells(a_data, "A")のところで、「実行時エラー13　型が一致しません」とエラーがでます。 不思議なのは、昨日は動いていたのです。 なぜ、エラーが出るようになったのかわかりません。 ご教授よろしくお願いします。 A B 1 a 1 2 2 3 3 4 4 5 5 6 b 6 7 7 8 8 9 9 10 10 11 c 11 12 12 13 13 14 14 15 15 Sub test() Wrow = Worksheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To Wrow If Worksheets("sheet1").Cells(i, "A").Value = "a" Then a_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "b" Then b_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "c" Then c_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "d" Then d_data = Worksheets("sheet1").Cells(i, "A").Row End If Next Sheets("sheet1").Select Range(Cells(a_data, "B"), Cells(b_data, "B")).Select ActiveSheet.ChartObjects.Add(30, 10, 500, 200).Select ActiveChart.ChartType = xlLineMarkers ActiveChart.SetSourceData Source:=Sheets("sheet1").Range(Cells(a_data, "B"), Cells(b_data - 1, "B")), PlotBy:=xlColumns ActiveChart.Location where:=xlLocationAsObject, Name:="sheet1" Sheets("sheet1").Select ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).Name = Cells(a_data, "A")　←エラーがでます。 ActiveChart.SeriesCollection(2).Values = Range(Cells(b_data, "B"), Cells(c_data, "B")) ActiveChart.SeriesCollection(2).Name = Cells(b_data, "A") ActiveChart.SeriesCollection(3).Values = Range(Cells(c_data, "B"), Cells(d_data, "B")) ActiveChart.SeriesCollection(2).Name = Cells(c_data, "A") End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する