質問投稿でgooポイントが当たるキャンペーン実施中!!>>

Excel 2007 マクロ 同列のデータの重複チェック

A列で重複しているデータをチェックします。
重複しているデータについて、B列にフラグをつけます。
フラグはどの行とどの行が重複しているのかわかるようにしたいです。
そのため重複している行同士ごとにフラグをつけます。

上記の内容はマクロで実現できるのでしょうか。

元データと完成形の画像を添付します。

よろしくお願いします。

「Excel 2007 マクロ 同列のデー」の質問画像

このQ&Aに関連する最新のQ&A

A 回答 (4件)

データを1回だけ読む方法で一案。



見出し(A1,B1)
データ(A2~~)
マクロ実行前に結果B列のクリアー不要。
 
'----------------------------------------
Sub Test()
 Dim myDic
 Dim Cnt As Long
 Dim Rng As Range
 Dim myRange As Range

 Set myRange = Range("A2", Cells(Rows.Count, "A").End(xlUp))
 myRange.Offset(0, 1).ClearContents

 Set myDic = CreateObject("Scripting.Dictionary")

For Each Rng In myRange
 If myDic.Exists(Rng.Value) = False Then
   If WorksheetFunction.CountIf(myRange, Rng) > 1 Then
     Cnt = Cnt + 1
     myDic.Add Rng.Value, Cnt
     Rng.Offset(0, 1).Value = Cnt
   End If
 Else
   Rng.Offset(0, 1).Value = myDic.Item(Rng.Value)
 End If
Next Rng

End Sub
'----------------------------------------------

以上です。
 
    • good
    • 0
この回答へのお礼

ご回答ありがとうございました。参考にさせて頂きます。シンプルな内容で助かります。

お礼日時:2010/10/18 23:59

A1セルに型番とありA2セル以降にデータがあるとしたらB2セルには次の式を入力して下方にオートフィルドラッグすればよいでしょう。

マクロで処理することもないように思いますが。

=IF(A2="","",IF(COUNTIF(A:A,A2)>1,IF(COUNTIF(A$1:A1,A2)>0,INDEX(B$1:B1,MATCH(A2,A$1:A1,0)),MAX(B$1:B1)+1),""))
    • good
    • 0
この回答へのお礼

ご回答ありがとうございました。参考にさせて頂きます。

お礼日時:2010/10/18 23:58

バリエーションを二つ追加させていただきます。


なお、B列は事前に空にしておく必要があります。

'連想配列を用いる方法
Sub test2()
Dim targetRange As Range, myCell As Range
Dim myDic As Object
Dim myKeys As Variant
Dim strKey As String
Dim i As Long, j As Long

Set myDic = CreateObject("Scripting.Dictionary")
With ActiveSheet
Set targetRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
End With
For Each myCell In targetRange.Cells
strKey = myCell.Value
If Not myDic.exists(strKey) Then
myDic.Add strKey, myCell
Else
Set myDic(strKey) = Union(myDic(strKey), myCell)
End If
Next
myKeys = myDic.keys
j = 1
For i = 0 To myDic.Count - 1
If myDic(myKeys(i)).Cells.Count > 1 Then
myDic(myKeys(i)).Offset(0, 1).Value = j
j = j + 1
End If
Next i
Set myDic = Nothing
End Sub

'オーソドックスな方法、但し高速化の為配列に入れて処理してみました
'あまり検証してないので、バグがあったら悪しからず
Sub test3()
Dim targetRange As Range
Dim i As Long, j As Long, k As Long
Dim buf As Variant
Dim hitFlag As Boolean

With ActiveSheet
Set targetRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp).Offset(0, 1))
End With
buf = targetRange
k = 1
For i = 1 To UBound(buf, 1)
hitFlag = False
If IsEmpty(buf(i, 2)) Then
For j = i + 1 To UBound(buf, 1)
If buf(i, 1) = buf(j, 1) Then
buf(i, 2) = k: buf(j, 2) = k
hitFlag = True
End If
Next j
End If
If hitFlag Then k = k + 1
Next i
targetRange = buf
End Sub
    • good
    • 0
この回答へのお礼

ご回答ありがとうございました。参考にさせて頂きます。

お礼日時:2010/10/18 23:58

こんばんは!


A列の2行目以降にデータがありB列に表示させるとします。
無理やりって感じになります。

一例ですが・・・

Sub test()
Dim i, j As Long
j = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To j
If WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(j, 1)), Cells(i, 1)) > 1 _
And WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(i, 1)), Cells(i, 1)) = 1 Then
Cells(i, 2) = WorksheetFunction.Count(Range(Cells(2, 2), Cells(i, 2))) + 1
End If
Next i
Dim k, L As Long
L = Cells(Rows.Count, 1).End(xlUp).Row
For k = 2 To L
If WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(L, 1)), Cells(k, 1)) > 1 Then
Cells(k, 2) = WorksheetFunction. _
VLookup(Cells(k, 1), Range(Cells(2, 1), Cells(L, 2)), 2, False)
End If
Next k
End Sub

2段階でやってみました。
重複数が2以上で初回に出てくるデータ行に1からの連番をB列に表示させ、
その結果を元にもう一度B列に重複数が2個以上の物は
VLOOKUPで既出数値を表示するようにしてみました。

以上、参考になればよいのですが
他に良い方法があればごめんなさいね。m(__)m
    • good
    • 0
この回答へのお礼

ご回答ありがとうございました。参考にさせて頂きます。

お礼日時:2010/10/18 23:57

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

Qエクセルマクロ:複数列 重複があった場合、メッセージと印入れる方法

いつもお世話になっております。
マクロについて行き詰まったので質問させてください。

管理票データがあって
A列~時間
B列~管理番号
C列~処理区分
D列~担当者名
E列~処理
F列~記事欄
G列以降は空き列

B列の管理番号に重複があった場合、
メッセージで知らせるマクロはネットを参考に使用させて頂いたのですが、

A列とB列とC列が一致したものが
同じ行にあった場合、メッセージで知らせると同時に
G列に重複している箇所に☆マークを入れるマクロに変えようとしましたが
複数列になるとマクロの書き方が今一わかりません。

色々、調べた結果
dicで格納させて、まとめてみるという方法があるようですが、
行き詰まってしまったので、どなたか、
良い方法があれば教えて頂けませんか?


下記に使わせてもらっているマクロのコードと
概要と添付にて図を表示します。
お手数ですが、宜しくお願い致します。


    A列      B列   C列   D列   E列  F列   G列~以降空き

1    時間      管理番号   区分   担当者   処理  記事欄
2 2015/09/01 10:00  D12345  新規申込 ○○○ 確認中       ☆ 
3 2015/09/01 10:10  D12346  新規申込 ○○○ 確認中  
4 2015/09/01 10:11  D12347  新規申込 ○○○ 確認中  
5 2015/09/01 10:00  D12345  新規申込 ○○○ 確認中       ☆


A列とB列とC列が一致したもの
(2015/09/01 10:00  D12345  新規申込 )と記述しているものが
2行目と5行目にあった場合、メッセージで表示させると同時に
G列に☆をいれる。




Option Explicit
Sub 重複チェック()

Dim i As Long
Dim j As Long
Dim z As Long
Dim Kanri As String
Dim cnt As Long
cnt = 0
With Sheets("管理票")
z = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To z
For j = i + 1 To z
If .Cells(i, 2).Value = .Cells(j, 2).Value Then
Kanri = .Cells(i, 2).Value
cnt = cnt + 1
MsgBox "下記の管理番号が重複しています" & vbCrLf & Kanri
Exit For
End If
Next j
Next i
If cnt = 0 Then

Exit Sub
End If
End With
End Sub

いつもお世話になっております。
マクロについて行き詰まったので質問させてください。

管理票データがあって
A列~時間
B列~管理番号
C列~処理区分
D列~担当者名
E列~処理
F列~記事欄
G列以降は空き列

B列の管理番号に重複があった場合、
メッセージで知らせるマクロはネットを参考に使用させて頂いたのですが、

A列とB列とC列が一致したものが
同じ行にあった場合、メッセージで知らせると同時に
G列に重複している箇所に☆マークを入れるマクロに変えようとしましたが
複...続きを読む

Aベストアンサー

以下でどうなりますか


Option Explicit

Public Sub Samp1()
  Dim dic As Object, dicE As Object
  Dim vA As Variant
  Dim sS As String
  Dim i As Long, j As Long
  Const CMK As String = "☆"

  Set dic = CreateObject("Scripting.Dictionary")
  Set dicE = CreateObject("Scripting.Dictionary")

  With Worksheets("管理票")
    With .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 3)
      vA = .Value
      For i = 1 To UBound(vA)
        sS = ""
        For j = 1 To UBound(vA, 2)
          sS = sS & "_" & vA(i, j)
        Next
        If (dic.Exists(sS)) Then
          vA(i, 1) = CMK
          vA(dic(sS), 1) = CMK
          dicE(vA(i, 2)) = Empty
        Else
          vA(i, 1) = Empty
          dic(sS) = i
        End If
      Next
      .Columns(1).Offset(, 6).Value = vA
    End With
    If (dicE.Count > 0) Then
      .Activate
      MsgBox "下記の管理番号が重複しています" & vbCrLf & vbCrLf _
          & Join(dicE.Keys, vbCrLf)
    End If
  End With

  Set dic = Nothing
  Set dicE = Nothing
End Sub


重複チェックする部分を vA に読み込みます
(A2 ~ A最終行範囲の3列分)
行単位で1つの文字列 sS を作成して(列間に "_" )
その文字列が dic にあるか確認して
・あったら、
今の行と dic に覚えていた行の1列目に ☆
メッセージ用に管理番号を dicE のキーとして覚えておく
(同じ管理番号が何度も重複して出現した際に1つにするため)
・なかったら
今の行を覚え、1列目をきれいに( Empty )しておく

これは、結果出力用に vA 1列目を使いまわしするため
(そもそも vA の内容は dic に覚えてしまうと不要になるので)

上記処理が終わったら、
>      .Columns(1).Offset(, 6).Value = vA
1列目基準の Offset で G 列指定して 結果出力
3列ある vA を代入しても左辺は1列分しかないので1列分だけ出力
シートへの書き出しは、この1回だけなので
Application.ScreenUpdating での描画云々は不要と思います

dicE の中身がカラでなかったら重複があったことになるから
管理票を見せつつメッセージの出力


ってな流れになります

以下でどうなりますか


Option Explicit

Public Sub Samp1()
  Dim dic As Object, dicE As Object
  Dim vA As Variant
  Dim sS As String
  Dim i As Long, j As Long
  Const CMK As String = "☆"

  Set dic = CreateObject("Scripting.Dictionary")
  Set dicE = CreateObject("Scripting.Dictionary")

  With Worksheets("管理票")
    With .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 3)
      vA = .Value
      For i = 1 To UBound(vA)
     ...続きを読む

Q[初心者です]VBAで指定列からAを検索し、発見したら隣のセルに値0を入れるマクロ。

VBAで指定列からAを検索し、発見したら隣のセルに0を入れるマクロを組みたいのですが、組み方がVBA初心者の為わかりません。
(例)
L列に、A、B、C、D、E、Fとランダムに文字が入っていて、
文字Aを検索し、発見したら隣のI列に値0を入れるというマクロです。

Sub Search()
Dim A As String
Set A = Worksheets("Sheet1").Cells.Find("A")
If A Is Nothing Then
ActiveCell.Offset(0, 1).Value = 0

End If
End Sub
と過去の質問で考えてみたのですが、Aがあった時、、、、
とコードが書けないです。
大変困っているので、ご教授頂けないでしょうか?
出来れば、そのままマクロに出来るコードを教えて頂けないでしょうか?
宜しくお願い致します。

Aベストアンサー

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表格が、この「Find」 です。

>Set A = Worksheets("Sheet1").Cells.Find("A")

>過去の質問で考えてみたのです

どうも、Find メソッドは、あるレベル以下の人は、省略する傾向があるようです。何が大事で、何が大事でないかというのは、やってみなければ分かりませんが、検索語だけを入れる書き方は、実務では、あまりしないほうがよいと思います。

だいたい、以下のTestFind2 ぐらいまでに、省略は、とどめたほうがよいです。

それは、Find は、必ずしも自分が思っているデフォルトとは違うことがあるので、「明示的(意図的に)」にオプションは入れたほうがよいです。
例えば、大文字小文字の違いを付けるなら、MatchCase:=True, 数式まで探すなら、LookIn:=xlFormulas

なお、Find メソッドは、5年経っても、たぶん完全に覚えられません。面倒なコードのひとつです。ですが、これはパターンが決まっているので、ひとつパターンが決まったら、それに当てはめればよいだけです。

#3さんで示されているMougのサンプルコードと似てはいるのですが、Mougのサンプルコードでは、Verionによって、失敗することがあります。

'--------------------------------------
'記録マクロをそのまま使う方法
Sub TestFind1()
Dim c As Range
 Set c = Columns("L:L").Find(What:="A", _
           After:=ActiveCell, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           SearchOrder:=xlByRows, _
           SearchDirection:=xlNext, _
           MatchCase:=False, _
           MatchByte:=False, _
           SearchFormat:=False)
 c.Offset(0, 1).Value = 0
End Sub
'--------------------------------------
'TestFind1 をアレンジしてみる
Sub TestFind2()
Dim c As Range
'検索語
Const MYTXT As String = "A"
 Set c = ActiveSheet.Columns("L:L").Find(What:=MYTXT, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           MatchCase:=False)
 If Not c Is Nothing Then
    c.Offset(0, 1).Value = 0
 End If
End Sub

'---------------------------------------
'複数ある場合(パターンを使った方法)
'---------------------------------------
Sub TestFind3()
  Dim c As Range
  Dim FirstAdd As String
  Const MYTXT As String = "A"
  Set c = ActiveSheet.Columns("L:L").Find( _
    What:=MYTXT, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    MatchCase:=False)
  
  If Not c Is Nothing Then
    FirstAdd = c.Address
    Do
      c.Offset(, 1).Value = 0
      Set c = ActiveSheet.Columns("L:L").FindNext(c)
      If c.Address = FirstAdd Then Exit Sub
    Loop Until c Is Nothing
  End If
End Sub

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表...続きを読む

QエクセルVBA 重複データから1種類ずつ抽出

いつもお世話になります。
5万行のエクセルデータで、A列に20種類のデータが重複しています。
このデータを、別シートのA1~A20に1種類ずつコピーしたいのです。
オートフィルタ→フィルタオプション→重複するレコードは無視するでチャレンジしてみたのですが、5万行だとデータ量の関係で時間がかかりすぎるので、VBAでもっと短時間で出来ないかと思い、投稿させていただきました。

よろしくお願いいたします。

Aベストアンサー

フィルタオプションによる抽出は速いという印象がありましたが、ユニークなデータ抽出は劇遅ですね。50000行のデータで終わるまで待てないで無理矢理終了させてしまいました。
この手の処理は連想配列が速いです。標準で機能を持っている言語もありますが、VBAの場合は別の(といってもWindowsが標準で持っている)ActiveXのお世話になる必要があります。下記のコードは、セル操作を最小限に止めるために配列に収納して操作する高速化の技も併用していますが、A列に5万行、乱数で作成したアルファベット2文字の文字列のユニークなリスト取り出しが100msec弱で処理できました。(Windows7Home(64bit), xl2010, Core i5 3.2GHz)
ご参考まで。
なお、APIは時間計測に使っているだけですので、気にしないで下さい。

Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub test()
Dim targetRange As Range, destRange As Range
Dim buf As Variant, buf2 As Variant
Dim myDic As Object
Dim i As Long
Dim myKeys As Variant
Dim startTime As Long

startTime = GetTickCount
Set targetRange = Sheets("Sheet1").Range("A1:A50000")
buf = targetRange
Set myDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 1 To 50000
myDic.Add buf(i, 1), ""
Next i
On Error GoTo 0
With Sheets("Sheet2")
Set destRange = .Range(.Range("A1"), .Range("A" & myDic.Count))
End With
buf2 = destRange
myKeys = myDic.keys
For i = 1 To myDic.Count
buf2(i, 1) = myKeys(i - 1)
Next i
destRange = buf2
MsgBox CStr(GetTickCount - startTime) & "msec"
End Sub

フィルタオプションによる抽出は速いという印象がありましたが、ユニークなデータ抽出は劇遅ですね。50000行のデータで終わるまで待てないで無理矢理終了させてしまいました。
この手の処理は連想配列が速いです。標準で機能を持っている言語もありますが、VBAの場合は別の(といってもWindowsが標準で持っている)ActiveXのお世話になる必要があります。下記のコードは、セル操作を最小限に止めるために配列に収納して操作する高速化の技も併用していますが、A列に5万行、乱数で作成したアルファベット2文字の文...続きを読む

QEXCEL VBA で指定した範囲に入力があるかどうか?

こんばんは!!
EXCEL VBAを使い出して、初日からつまずいてます・・・。
みなさん、アドバイスよろしくお願いします!!

で、早速、質問なんですけど、
指定したセル範囲のいずれかに入力があるか調べたいんですけど、それができるプロパティとかってあるんでしょうか?
地道にセル毎にチェックするしかないいんでしょうか??

たとえば、範囲をA1:H1として、その範囲内のセルに何か入力があったらTrueが返ってくるとか・・・。

もし、知ってる方がいらっしゃたら教えてください!!
よろしくお願いします!!!!!

Aベストアンサー

>これは、まず範囲を選択して、入力チェック()を呼ぶことなのでしょうか
書いたモジュールは範囲が指定してあります。("A1:H11"は間違いです。質問からすると"A1:H1"です)何もしないで入力チェックを実行します。
モジュールを CountA(Selecton) に変えれば任意の選択範囲がチェックの対象になります。任意の範囲を選択して実行します。
メッセージは確認するためで、IF ・・・・ で入力有無が判定できます。

>ワークシート関数CountAってどうやったら出てくるんですか??
ついApplicationと書いてしまうんですが、『WorksheetFunction.』と打てば、候補の関数名が表示されると思います。

下記の fnc入力チェック は入力有無を返すユーザー定義関数です。
書き方の例です。分かりやすくなった?この例は引数に"A1:H1"をセットしています。任意の範囲にするには Selection.Address に変えます。

Sub 入力チェック()
  Dim 入力有無フラグ As Boolean        '入力有無の答え

  入力有無フラグ = fnc入力チェック("A1:H1")  'モジュール内でA1~H1を指定(固定)

  MsgBox 入力有無フラグ            '帰ってきた答えをメッセージボックスで確認
End Sub

'入力有無を返すユーザー定義関数
Function fnc入力チェック(checkAddress As String)
  If WorksheetFunction.CountA(Range(checkAddress)) > 0 Then
    fnc入力チェック = True
  Else
    fnc入力チェック = False
  End If
End Function

>これは、まず範囲を選択して、入力チェック()を呼ぶことなのでしょうか
書いたモジュールは範囲が指定してあります。("A1:H11"は間違いです。質問からすると"A1:H1"です)何もしないで入力チェックを実行します。
モジュールを CountA(Selecton) に変えれば任意の選択範囲がチェックの対象になります。任意の範囲を選択して実行します。
メッセージは確認するためで、IF ・・・・ で入力有無が判定できます。

>ワークシート関数CountAってどうやったら出てくるんですか??
ついApplicationと書いてし...続きを読む

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

QExcel VBAを使った重複行の抜き出しについて教えてください

以下のような2シートから、重複する「商品番号」のあるsheet1の行を抜き出して、別シートに書き出したいと思っております。

sheet1
 |  A   |  B   | C
-+--------+-------+-----
1|      |      |
-+--------+------+--------
2|商品番号|商品名|責任者
-+--------+------+--------
3|  123456|  ガム|山田太郎
-+--------+------+--------
4| 2345678| チョコ|田中花子
・・・

sheet2
 |  A   |  B   | C
-+--------+-------+-----
1|      |     |
-+--------+------+--------
2|商品番号|商品名|責任者
-+--------+------+--------
3| 3987624|     |
-+--------+------+--------
4| 193678|      |
・・・

そこでVBAを作成したのですが、例えば商品番号「222011001」の行を抜き出したいのに、「22011001」の行も一緒に抜き出してしまいます。
どこがいけないのか、教えて頂けないでしょうか。
作成したVBAは以下の通りです。
VBA初心者で本を見ながら作ったため、大変見にくくなっているかと思います。申し訳ありませんが、どなたかおわかりになる方がいらっしゃいましたら、どうぞ宜しくお願い致します。

Option Base 1
Option Explicit
Sub 重複データ抽出書き直し()
Dim シート(2) As Worksheet
Dim 比較列(2) As Integer
Dim 一致セル As Range
Dim 検索範囲 As Range
Dim i As Integer

Set シート(1) = Sheets("sheet1")
Set シート(2) = Sheets("sheet2")
比較列(1) = 1: 比較列(2) = 1

シート(2).Activate
ActiveCell.CurrentRegion.Select
Selection.Offset(1, 比較列(2) - 1) _
.Resize(Selection.Rows.Count - 1, 1) _
.Select
Set 検索範囲 = Selection

Sheets.Add After:=Sheets(Sheets.Count)
シート(1).Activate
ActiveCell.CurrentRegion.Select
Selection.Resize(1).Copy
With Sheets(Sheets.Count).Range("A1")
If Application.Version >= 9 Then
.PasteSpecial 8
End If
.PasteSpecial
End With

For i = 2 To Selection.Rows.Count
Set 一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value)

If Not 一致セル Is Nothing Then
Selection.Offset(i - 1).Resize(1) _
.Copy Sheets(Sheets.Count) _
.Range("A65536").End(xlUp) _
.Offset(1)
End If
Next i

Sheets(Sheets.Count).Activate
End Sub

以下のような2シートから、重複する「商品番号」のあるsheet1の行を抜き出して、別シートに書き出したいと思っております。

sheet1
 |  A   |  B   | C
-+--------+-------+-----
1|      |      |
-+--------+------+--------
2|商品番号|商品名|責任者
-+--------+------+--------
3|  123456|  ガム|山田太郎
-+--------+------+--------
4| 2345678| チョコ|田中花子
・・・

sheet2
 |  A   |  B   | C
-+--------+----...続きを読む

Aベストアンサー

こんにちは。

初心者とお書きになっていますが、他のプログラミング言語をおやりになっていますね。ただ、Excel VBAでは、使わないような方法がいくつもあります。VBAは、個人的なもので、なおかつ結果オーライですから、それに関しては、余計なお世話になってしまいますが、かなり入り組んだスキルが混じっている内容だと思います。特に、他人に見せる場合は、なるべく、オーソドックスなスタイルにしたほうがよいです。

個々の問題点ですが、

>例えば商品番号「222011001」の行を抜き出したいのに、「22011001」の行も一緒に抜き出してしまいます。

>一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value)

Find メソッドは、必要な引数は必ず入れてください。ワークシート(Excel)のメソッドは、VBAの概念とは違う仕様を持っていますので、使用する場合は気をつけたほうがよいです。デフォルトがデフォルトでないこともあります。

Set 一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value,)
   ↓
Set 一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value, , , xlWhole)

もしも、Excel97を意識しているなら、いっそ、Application.Match(検索値,範囲,0)やCountIfを使ったほうがよいと思います。

それから、オブジェクトは、一般的には、配列にはしないで、Collectionにします。しかし、数が少ない場合は、個々に変数に代入します。

サンプルコード:
以下は、新しくペーストされるシートの重複も避けるように作られています。(以下の、Application.ワークシート関数は、古いスタイルの書き方です)

Sub getDoubledItems()
  Dim Sh1 As Worksheet
  Dim Sh2 As Worksheet
  Dim NewSh As Worksheet
  Dim ret As Integer
  Dim i As Long
  Dim col As Integer
  
  Set Sh1 = Worksheets("Sheet1")
  Set Sh2 = Worksheets("Sheet2")
  Set NewSh = Worksheets.Add(After:=Sheets(Sheets.Count))
  
  col = Sh1.Range("A2").CurrentRegion.Columns.Count
  Sh1.Range("A2").Resize(, col).Copy NewSh.Range("A1")
  'ここにセル幅の調整用のコードを入れます。
  
  Application.ScreenUpdating = False
  With Sh1
    For i = 3 To .Range("A65536").End(xlUp).Row
      ret = Application.CountIf(Sh2.Columns(1), .Cells(i, 1).Value)
      If ret > 0 Then
        If Application.CountIf(NewSh.Columns(1), .Cells(i, 1).Value) = 0 Then
          .Cells(i, 1).Resize(, col).Copy NewSh.Range("A65536").End(xlUp).Offset(1)
        End If
      End If
    Next i
  End With
  Application.ScreenUpdating = True
  Set Sh1 = Nothing: Set Sh2 = Nothing: Set NewSh = Nothing
End Sub

こんにちは。

初心者とお書きになっていますが、他のプログラミング言語をおやりになっていますね。ただ、Excel VBAでは、使わないような方法がいくつもあります。VBAは、個人的なもので、なおかつ結果オーライですから、それに関しては、余計なお世話になってしまいますが、かなり入り組んだスキルが混じっている内容だと思います。特に、他人に見せる場合は、なるべく、オーソドックスなスタイルにしたほうがよいです。

個々の問題点ですが、

>例えば商品番号「222011001」の行を抜き出したいのに、「2...続きを読む

Qある範囲のセルから任意の値を検索して、その隣のセルの値を取得するという関数はありますか?

Excelの関数について質問します。
ある範囲のせるを検索して、その隣のセルの値を取得するという関数を探しています。
なければユーザー定義で作りたいと思っています。
VLOOKUP関数では一番左端が検索されますが、
それをある範囲まで拡張して、
その右隣の値を取得できるようにしたいのです。
どうかお知恵をお貸しください。

Aベストアンサー

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場合によっては、IFをかぶせてCOUNTIFで確認した方が良いかもしれません。
 ex. =IF(COUNTIF(A1:F200,X1)=1,【上記数式】,"えらー")

ちなみに、VBAでやるならこんな感じになるかと。

動作の概要
 【検査範囲】から【検査値】を探し、
 最初にHITしたセルについて、右隣のセルの値を返す。
 ex. =Sample(X1,A1:F200)

'--------------------------↓ココカラ↓--------------------------
Function Sample(ByVal 検査値 As Variant,ByVal 検査範囲 As Range)
 For Each セル In 検査範囲
  If セル = 検査値 Then Exit For
 Next セル
 Sample = セル.Offset(0, 1)
End Function
'--------------------------↑ココマデ↑--------------------------

いずれもExcel2003で動作確認済。
以上ご参考まで。

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場...続きを読む

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。


人気Q&Aランキング