EXCEL VBAについて質問です。良い回答は300~600ptを差し上げます。

やりたいことは、
製品NO(C列)が同一番号で製品(A列)が「KIT」以外のデータに対して、カテゴリ(E列)に「ベース」の文字列を挿入したい。

更新後のイメージ--------------------------------------------------------
  A     B               C      D       E
1 製品   名称             製品NO  資産NO  カテゴリ
2 ソフト  マルモのおきて       110012  1485   ベース
3 KIT    マルモのおきて SP     110012  1329
4 ソフト  星の金貨           110001  4568   ベース
5 KIT    続 星の金貨        110001  6821
6 ソフト  全開ガール          110025  5581
-------------------------------------------------------------------------
ソースでの回答を希望します。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2011/09/24 00:07:36
  • 終了:2011/09/24 11:12:35

ベストアンサー

id:taknt No.3

きゃづみぃ回答回数13537ベストアンサー獲得回数11982011/09/24 11:02:27

ポイント400pt

普通ならば 数式を セルに貼り付ければ 一発なんですけどね。

=IF(A2="KIT","",IF(COUNTIF(D:D,"=" & D2)>1,"ベース",""))

これを H2に貼り付けて、それをコピーして H3以降に貼り付ければいいだけです。

でも それをしたくないならば 多少は 時間がかかりますが

Sub main()
    Dim c As String
    Dim a As Long
    Application.ScreenUpdating = False
    For a = 2 To Range("A1").End(xlDown).Row
        If Cells(a, "A") <> "KIT" Then
            If Application.WorksheetFunction.CountIf(Range("D:D"), "=" & Cells(a, "D")) > 1 Then Cells(a, "H") = "ベース"
        End If
    Next a
    Application.ScreenUpdating = True
End Sub

とやるしかないでしょう。


追記

列の変更をしました。

id:japan-nan

回答いただきありがとうございました。

望みが叶いました!

2011/09/24 11:11:25

その他の回答(2件)

id:Jupiter2100 No.1

じゅぴたー回答回数444ベストアンサー獲得回数742011/09/24 01:02:30

ポイント50pt

こんな感じでどうでしょう。

Sub hoge()
    Dim cnt, t, n, r0, r1 As Long
    Dim rr(9999) As Long              '最大行数分用意してください
    n = Range("C1").End(xlDown).Row
    For r0 = 1 To n
        'ワーク変数の初期化
        For r1 = 0 To n
            rr(r1) = 0
        Next r1
        'より下に重複要素があるか検査
        cnt = 0
        t = 1
        For r1 = r0 To n
            If Cells(r0, 3).Value = Cells(r1, 3).Value Then
                cnt = cnt + 1
                If Cells(r1, 1) <> "KIT" Then
                    rr(t) = r1
                    t = t + 1
                End If
            End If
        Next r1
        If (cnt > 1) Then
            For r1 = 1 To t
                If (rr(r1) > 0) Then
                    Cells(rr(r1), 5).Value = "ベース"
                End If
            Next r1
        End If
    Next r0
End Sub
id:japan-nan

回答いただき有り難うございます。

実際のデータが32,000行あり、実行すると10分間かかってしまいました。

対象をオートフィルターしたものだけにすることは可能でしょうか?

2011/09/24 03:08:31
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912011/09/24 02:30:34

ポイント50pt

一般関数でも求められると思いますが、一応マクロにしました。

 .Value = .Value

の部分を削除するれば数式の状態が見れますので、確認できるかと思います。


補足ですがこのマクロでしたら、フィルタで表示されている部分だけが

対象となりますので、このまま使用できます。


40000行のデータで試してみましたが、そのままでも20秒ほどで結果が出ました。

関数の利用はマクロより遅いと思われるかもしれませんが、Find や Sum

などはマクロよりもはるかに高速です。


内容にもよりますが、マクロでやるにしてもマクロから関数を利用した方が

シンプルで高速に処理できるケースは結構多いです。

VBA高速化テクニック ~ 関数も使え! ~


Sub CheckBase()
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row
    With Range("H2:H" & lastRow)
        .FormulaR1C1 = "=IF(AND(COUNTIF(R2C4:R" & lastRow & "C4,RC4)>=2,RC1<>""KIT""),""ベース"","""")"
        .Value = .Value
    End With
End Sub

コメントへの対応しました。

R が行、Cが列になります。

id:japan-nan

回答いただきありがとうございます。

実際のデーターは列の指定先が若干違いまして、

赤で記載している部分の変更を教えていただけたらと思います。

> .FormulaR1C1 = "=IF(AND(COUNTIF(R2C3:R" & lastRow & "C3,RC3)>=2,RC1<>""KIT""),""ベース"","""")"

製品NO(C列) ⇒ D列

カテゴリ(E列) ⇒ H列

2011/09/24 10:54:14
id:taknt No.3

きゃづみぃ回答回数13537ベストアンサー獲得回数11982011/09/24 11:02:27ここでベストアンサー

ポイント400pt

普通ならば 数式を セルに貼り付ければ 一発なんですけどね。

=IF(A2="KIT","",IF(COUNTIF(D:D,"=" & D2)>1,"ベース",""))

これを H2に貼り付けて、それをコピーして H3以降に貼り付ければいいだけです。

でも それをしたくないならば 多少は 時間がかかりますが

Sub main()
    Dim c As String
    Dim a As Long
    Application.ScreenUpdating = False
    For a = 2 To Range("A1").End(xlDown).Row
        If Cells(a, "A") <> "KIT" Then
            If Application.WorksheetFunction.CountIf(Range("D:D"), "=" & Cells(a, "D")) > 1 Then Cells(a, "H") = "ベース"
        End If
    Next a
    Application.ScreenUpdating = True
End Sub

とやるしかないでしょう。


追記

列の変更をしました。

id:japan-nan

回答いただきありがとうございました。

望みが叶いました!

2011/09/24 11:11:25

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません