|
やっちんさん、かみちゃんさん、 Hirofumi さん
ご回答ありがとうございました。
コードは、自分でできるところは自分で考えようと思い
ネットや本で調べながら拾い拾いつなげて考えました。
なので、とても混乱してしまっています。
難しいところは、ただ関数を貼り付けただけのコードに
変えてみました。
お恥ずかしいのですが、いちおうすべてのコードは
下のようになっています。
>
>配列に1列しか取得していないのに、5列目(配列に無い列)を見ているから
>当然、インデクスエラーが出るでしょう
Set rngList = S2.Cells(2, 5)
S2というのはsheet2です。
sheet1からsheet2へ値をコピーするというコードがあるからです。
「sheet2のCells(2, 5)の値が整数3ケタだったら前から2番目にドット」
としたかったのですが、
If IsNumeric(vntData(v, 1)) = True Thenを
If IsNumeric(vntData(v, 5)) = True Thenとすれば
Cells(2, 5)の式が、vが2から最終行まで繰り返しできると
思ってしまいました。
>後、何故、「For v = 2 To lngRows」が2から始まっているのですか?
v = 1 は見出しとなっていてデータが入っていないからです。
どうぞよろしくお願いいたします。
Dim S1 As Worksheet, S2 As Worksheet
Dim WSh As Worksheet
Dim v As Long
Dim i As Integer
Dim lngEndROW As Long
Dim lngRows As Long
Dim rngList As Range
Dim vntData As Variant
Dim strProm As String
Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")
S2.Columns("B:C").Value = S1.Columns("B:C").Value
S2.Columns("E:E").Value = S1.Columns("D:D").Value
S2.Columns("F:F").Value = S1.Columns("Q:Q").Value
'最終行取得
lngEndROW = Range("B65536").End(xlUp).Row
i = lngEndROW
'BC列連結
With S2.Range("D2:D" & i)
.Formula = "=CONCATENATE(C[-2],""/"",C[-1])"
.Value = .Value
End With
'D列置換
S2.Range("D2:D" & i).Replace what:="/_", replacement:=" ", lookat:=xlPart, MatchCase:=False
'サイズ別表示
Set rngList = S2.Cells(2, 5)
With rngList
'データ行数を取得
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
'データが無い場合
If lngRows <= 1 And .Value = "" Then
strProm = "データが有りません"
GoTo Wayout
End If
'データを配列に取得
vntData = .Resize(lngRows + 1).Value
End With
For v = 1 To lngRows
If IsNumeric(vntData(v, 1)) Then
If Len(vntData(v, 1)) = 3 Then
vntData(v, 1) = Left(vntData(v, 1), 2) & "." & Right(vntData(v, 1), 1)
End If
End If
Next v
'画面更新を停止
Application.ScreenUpdating = False
With rngList.Offset(, 1).Resize(lngRows)
.NumberFormatLocal = "@"
.Value = vntData
End With
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
MsgBox strProm, vbInformation
'G列在庫数ルール
With S2.Range("G2:G" & i)
.Formula = "=IF(F2<2,0,IF(F2<6,1,IF(F2<10,2,99)))"
.Value = .Value
End With
With Range("H2:H" & Range("B65536").End(xlUp).Row)
.Formula = _
"=IF(D2<>D3,""mark"","""")&IF(D1=D2,H1&"","","""")&E2&""/""&LOOKUP(G2,{0,2,6,10},{""00"",""01"",""02"",""99""})"
.Value = .Value
Range("H:H").AutoFilter field:=1, Criteria1:="<>mark*"
.SpecialCells(xlCellTypeVisible).ClearContents
ActiveSheet.AutoFilterMode = False
.Replace what:="mark", replacement:="", lookat:=xlPart
End With
End Sub
|
|