| |
▼Kein さん、かみちゃんさん：
どうもありがとうございました。
With〜If〜Else〜End Ifの使い方、よくわかりました。
コードを実行すると、違うところでエラーになってしまいました。
こういう場合は、ちがうトピックをたてるのでしょうか。
この場で教えていただければうれしいです。
一応、すべてのコードを書きます。
最後から2行目の Next i で「Nextで指定された変数の参照が不正です」
のエラーがでます。
もともと、前任者が作ったコードを変えたもので、＝＝＝＝で囲った
部分は必要ないのですが、(1,v)がアルファベットサイズの行から先が
Range("AM:AM")に抽出できていないため、いちおう書いておきました。
この部分は難しすぎて、よくわかりません。
わかりずらくてすみません。
よろしくお願いします。
Sub 在庫()
Dim C As Range
Dim i As Integer, v As Integer
Dim Bs As String, St As String
Dim lngEndROW As Long
Dim test As Variant, sizeIndex As Variant
'ターゲットシート指定
shName = "ｱｸｾｻﾘｰ"
With Worksheets("ｱｸｾｻﾘｰ")
For v = 38 To 5 Step -1
test = .Cells(1, v).Value
If Not IsNumeric(test) Then
If test = "総計" Or test = "その他" Then
.Columns(v).Delete xlShiftToLeft
End If
Else
If Len(test) = 4 Then
.Cells(1, v).Value = _
Left(test, 2) & "-" & Right(test, 2)
.Cells(1, v).Value = VBA.Trim(.Cells(1, v).Value)
ElseIf Len(test) = 3 Then
.Cells(1, v).NumberFormat = "@"
.Cells(1, v).Value = _
Left(test, 2) & "." & Right(test, 1)
End If
End If
Next v
End With
'置換 （特殊なサイズ）
Worksheets(shName).Range("E1:AJ1").Replace what:="_", replacement:="", lookat:=xlPart
Worksheets(shName).Range("E1:AJ1").Replace what:="OSFX", replacement:="OS-FX", lookat:=xlPart
Worksheets(shName).Range("E1:AJ1").Replace what:="OSFZ", replacement:="OS-FZ", lookat:=xlPart
'最終行取得
lngEndROW = Worksheets(shName).Range("A65536").End(xlUp).Row
For i = 2 To lngEndROW
If lngEndROW < 2 Then Exit Sub
sizeFlag = False
Bs = "": St = ""
For Each C In Worksheets(shName).Cells(i, 5).Resize(, 36)
Bs = Trim(Worksheets(shName).Cells(1, C.Column).Text)
'在庫数による文字列操作
Select Case C.Value
Case Is = "": St = St
Case Is < 2: St = St & Bs & "/00,"
Case Is < 6: St = St & Bs & "/01,"
Case Is < 10: St = St & Bs & "/02,"
Case Else: St = St & Bs & "/99,"
End Select
'==============================================================
'衣服サイズか？ （英字のサイズがある場合に並び替えの必要あり）
If C.Value <> "" And (Bs = "XS" Or Bs = "S" Or Bs = "M" Or Bs = "L" Or Bs = "XL" Or Bs = "O" Or Bs = "XO" Or Bs = "2XO" Or Bs = "OG" Or Bs = "OS-FX" Or Bs = "OS-FZ") Then
sizeFlag = True
End If
Next
'サイズが衣服サイズなら並び替え
If sizeFlag Then
Dim dic, spArray, cnt, tmpName, tmpData
Set dic = CreateObject("Scripting.Dictionary")
spArray = Split(St, ",")
For cnt = 0 To (UBound(spArray) - 1)
tmpName = Mid(spArray(cnt), 1, InStr(spArray(cnt), "/") - 1)
dic.Add tmpName, spArray(cnt)
Next
St = ""
For cnt = 0 To (UBound(sizeIndex))
tmpData = dic(sizeIndex(cnt))
If Not IsNull(tmpData) And tmpData <> "" Then
St = St & tmpData & ","
End If
Next
End If
'=============================================================
'値の代入
Worksheets(shName).Range("AM:AM").NumberFormat = "@"
St = Left$(St, Len(St) - 1)
Worksheets(shName).Cells(i, 39).Value = Trim(St)
Next i
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
