Microsoft Access Club Access超初心者対象Forum Access初・中級者対象Forum Access VBA Tips Forum DAO、ADO、SQL Forum

     

リストへもどる

投稿記事の一括表示

タイトルExcelのマクロをグレードアップさせてAccessに移したい
記事No83107
投稿日: 2017/05/18(Thu) 17:40
投稿者すこやか
OS:Windows7
Access Version:Access2013

お世話になります。
題の通り、これまでExcelで行っていたマーキングをAccessでやりたいと思っております。

・同客番で期間が被っているとき、抽出
・別客番で契約が被っているとき、抽出
・全く同じデータのとき、抽出

上記の条件でレコード抽出を行いたいと思っております。
今まではマーキングのみでしたが、問題のあるデータのみ抽出したいです。

下記Excelのマクロ構文です。



Sub 重複をマーキング()

Dim RetRange As Range
Dim maxCount As Integer

'@ A列に文字列結合してください
' =物件コード&棟コード&部屋コード
'A A2から列の最大のを指定してください(多めでもOKです)
maxCount = 190


' 色クリア
For i = 2 To maxCount
Cells(i, 1).Interior.ColorIndex = 0
Next

'以下の順でソート(Ascending)
'@物件コード
'A棟コード
'B部屋コード
'C客番
'D前回日
'E今回日
'F契約
Range(Cells(2, 1), Cells(maxCount, 26)) _
.Sort Key1:=Cells(1, 10), order1:=xlAscending, _
Key2:=Cells(1, 12), order2:=xlAscending, _
Key3:=Cells(1, 17), order3:=xlAscending

Range(Cells(2, 1), Cells(maxCount, 26)) _
.Sort Key1:=Cells(1, 1), order1:=xlAscending, _
Key2:=Cells(1, 8), order2:=xlAscending

'検索範囲設定
Range(Cells(2, 1), Cells(maxCount, 1)).Select

'描画停止
Application.ScreenUpdating = False

For i = 2 To maxCount

Application.StatusBar = i & " / " & maxCount & " 行目の処理をしています..."

Set RetRange = Selection.Find(What:=Cells(i, 1).Value, _
after:=Cells(i, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not RetRange Is Nothing Then
If RetRange.Address <> Cells(i, 1).Address Then

destRow = RetRange.Row

'前回日
dateDestFrom = Cells(destRow, 10).Value
dateFrom = Cells(i, 10).Value

'今回日
dateDestTo = Cells(destRow, 12).Value
dateTo = Cells(i, 12).Value

'客番
'customerNoRet = Cells(destRow, 8).Text
'customerNoSerch = Cells(i, 8).Text

'契約
keiyakuRet = Cells(destRow, 17).Text
keiyakuNoSerch = Cells(i, 17).Text

'会社
siteRet = Cells(destRow, 7).Text
siteNoSerch = Cells(i, 7).Text

If (dateFrom <= dateDestFrom And dateTo > dateDestFrom) _
Or (dateFrom < dateDestTo And dateTo >= dateDestTo) _
Or (dateDestFrom <= dateFrom And dateDestTo > dateFrom) _
Or (dateDestFrom < dateTo And dateDestTo >= dateTo) Then '期間かぶり有り
If customerNoRet = customerNoSerch Then
RetRange.Interior.ColorIndex = 6
Cells(i, 1).Interior.ColorIndex = 6
Else
If keiyakuRet = keiyakuNoSerch Then
RetRange.Interior.ColorIndex = 6
Cells(i, 1).Interior.ColorIndex = 6
End If
End If
Else '期間かぶり無し
End If
End If

End If
End If


どの部分が条件を示しているか判断がつかない状況です。
クエリで作ろうと思ったのですがそれも難しく、四苦八苦しております。
よろしくお願い申し上げます。

タイトルRe: ExcelのマクロをグレードアップさせてAccessに移したい
記事No83108
投稿日: 2017/05/18(Thu) 19:35
投稿者tkwan
>・同客番で期間が被っているとき、抽出
>・別客番で契約が被っているとき、抽出
>・全く同じデータのとき、抽出

具体的なデータ例で示してもらえますか?

- 以下のフォームから自分の投稿記事を修正・削除することができます -
処理 記事No パスワード

ページの先頭へ 前ページへ戻る