| |
はじめまして。
VBAマクロを使い出して日が浅いのですが、自力で構成するのに限界を感じたので、
質問させて頂きます。
構成としては
ファイルa → マクロをセットしてあるファイル
ファイルb → 物一つ一つに管理番号が振ってあり、管理しているファイル
ファイルc → 古い管理番号と新しい管理番号が記載されているファイル
ファイルcにはファイルbに同じ管理番号が記載されており（仮に管理番号A1とします）これに新しい管理番号（仮に管理番号B1とします）をファイルbの管理番号A1と
管理番号B1を置き換えるマクロを考えております。
ファイルbに記載されている古い管理番号は色を変えていますので、新しい管理番号に変える際に、色を消す必要があります。
ファイルcは日付ごとに別れており、管理番号もA1〜AXまでと複数あります。
また、ファイルcの管理番号も全て入れ替える訳ではなく、飛び飛びで入れ替えます。
以上を踏まえた上でご指摘お願い致します。
お見苦しいかと思いますがご容赦願います。
Windows("ファイルa.xls").Activate
fName = Worksheets("Sheet1").Range("A1").Value & ".xls" 'ここでファイル名を任意に指定することで応用性を持たせる。
Dim WHK As Range
Dim WHK1 As Range
Dim WHK2 As Range
Dim keizoku1
Dim keizoku2
Dim keizoku3
Dim ser As Worksheet
Dim WBK As Workbook
Dim SH1 As Worksheet
Dim ord As String
Dim nord As String
Dim jno As String
Dim no As Integer
Dim lastno
Set WBK = Workbooks(fName)
Set SH1 = WBK.Worksheets("台帳")
Windows("ファイルb.xls").Activate
Set ser = Worksheets("商品A")
no = 4
lastno = SH1.Range("R3")
SH1.Range("R2") = no
err = 0
Do
star:
ord = SH1.Range("O2") ;ここで管理番号を参照しています
nord = SH1.Range("P2")
jno = SH1.Range("Q2")
Set WHK = SH1.Range(ord)
Set WHK1 = SH1.Range(nord)
Set WHK2 = SH1.Range(jno)
OCOLOR = 6 ;ここで色を指定しています。
NCOLOR = -4142
no = SH1.Range("R2")
CHANGE = 0
Windows("ファイルb.xls").Activate
On Error GoTo pass
Sheets("商品A").Select
Cells.Find(What:=WHK.Text, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
On Error GoTo pass
If er = 0 Then
keizoku1 = MsgBox("前管理番号" & WHK, vbYesNoCancel)
Select Case keizoku1 ;ここで置き換える番号を確認しています
Case vbYes
GoTo chang1
Case vbNo '
GoTo enda1
Case vbCancel
GoTo enda
Case Else
GoTo enda
End Select
chang1:
keizoku2 = MsgBox("新管理番号"& WHK1, vbYesNoCancel)
Select Case keizoku2
Case vbYes
GoTo chang2
Case vbNo
GoTo enda1
Case vbCancel
GoTo enda
Case Else
GoTo enda
End Select
chang2:
keizoku3 = MsgBox("商品名" & WHK2, vbYesNoCancel)
Select Case keizoku3
Case vbYes
GoTo chang3
Case vbNo
GoTo enda1
Case vbCancel
GoTo enda
Case Else
GoTo enda
End Select
chang3:
Application.FindFormat.Interior.ColorIndex = OCOLOR
Application.ReplaceFormat.Interior.ColorIndex = OCOLOR
Sheets("商品A").Select
Cells.Find(What:=WHK.Text, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:=WHK.Text, Replacement:=WHK1.Text, LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
enda1:
no = no + 1
SH1.Range("R2") = no
End If
If no = lastno Then GoTo enda
Loop While no < 40
pass:
err = 1
no = no + 1
SH1.Range("R2") = no
GoTo star
Windows("ファイルa.xls").Activate
enda:
End Sub
動かしてみると、管理番号の参照までは成功するのですが、管理番号の置き換えとセルの色を変えることができません。
Application.FindFormat.Interior.ColorIndex = OCOLOR
Application.ReplaceFormat.Interior.ColorIndex = OCOLOR
Sheets("商品A").Select
Cells.Find(What:=WHK.Text, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:=WHK.Text, Replacement:=WHK1.Text, LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
この辺の処理がおかしいからだと思うのですが、どこをどう変えたら動くのかさっぱりわかりません･･･
どなたかご教授お願い致します。
|
|
このえ
- 11/7/18(月) 19:36 -
