| |
▼YN さん：
おはようございます。
>WindowsとOfficeのバージョン
>EXCEL2000（Win98）です。
>
>サンプルは全く同じものを使っております。
>多分変数の設定で引っかかっているように感じます。
同じWin98&Excel2000で確認しましたが、未だ再現出来ません。
ひょっとして、
コード記述モジュールに
Option Explicit
これを宣言していますか？
そうだたしたら、削除してください。
でもこれだとしてもエラーがご提示されたものとは違いますが・・・。
>変数の抜けているものがありましたら、明示していただけませんでしょうか。
一応、変数を宣言したコードです。
'==============================================================
Option Explicit
'==============================================================
Sub main()
Dim rng As Range
Dim rnga As Range
Dim rngb As Range
Dim tr As Range
Dim ctag As Range
Dim maxbnd As Long
Dim ad1 As String, ad2 As String
Dim sushiki As String
Dim ans As Variant
Dim idx As Long
maxbnd = 0
Worksheets("sheet2").Cells.ClearContents
Set rnga = Range("a2", Cells(Rows.Count, 1).End(xlUp))
Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
If rng.Count >= 2 Then
rng.Resize(, 2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("sheet2").Range("a1"), _
Unique:=True
With Worksheets("sheet2")
Set rngb = .Range("a2", .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each tr In rngb
ad1 = tr.Address(, , xlR1C1, True)
ad2 = tr.Offset(0, 1).Address(, , xlR1C1, True)
sushiki = "=IF(AND(rc1=" & ad1 & ",rc2=" & ad2 & "),IF(ISNUMBER(rc[-2]),rc[-2]))"
ans = get_num_value(rnga.Offset(0, 4).Resize(, 2), sushiki)
If VarType(ans) <> vbBoolean Then
If UBound(ans) > maxbnd Then maxbnd = UBound(ans)
With tr.Offset(0, 2).Resize(, UBound(ans))
.Value = ans
.NumberFormatLocal = "yyyy/m/d"
End With
End If
Next
If maxbnd > 0 Then
For Each ctag In Worksheets("sheet2").Range("c1", Worksheets("sheet2").Cells(1, maxbnd + 2))
ctag.Value = "日付" & idx + 1
idx = idx + 1
Next
End If
End If
End Sub
'=====================================================================
Function get_num_value(rng As Range, sushiki As Variant) As Variant
Dim clct As New Collection
Dim ansrng As Range
Dim addvalue As Variant
Dim cnt As Long
Dim ans() As Variant
Dim cr As Range
Dim idx As Long
get_num_value = False
With rng
.Formula = sushiki
On Error Resume Next
Set ansrng = .SpecialCells(xlCellTypeFormulas, xlNumbers)
If Err.Number = 0 Then
Err.Clear
cnt = 0
For Each cr In ansrng
If cnt + 1 < ansrng.Count Then
clct.Add cr.Value, Str(cr.Value)
Else
addvalue = cr.Value
End If
cnt = cnt + 1
Next
ReDim ans(1 To clct.Count + 1)
For idx = 1 To clct.Count
ans(idx) = clct.Item(idx)
Next
ans(clct.Count + 1) = addvalue
get_num_value = ans()
End If
.ClearContents
End With
Set clct = Nothing
End Function
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
