- Excel VBA 質問スレ Part39 [転載禁止]©2ch.net
507 ：デフォルトの名無しさん[sage]：2016/01/21(木) 01:07:45.84 ID:0jk7vnPh - >>499
Function RefCheck(CheckRange As Range) As Boolean
If CheckRange Is Nothing Then Exit Function
RefCheck = True
For Each x In ThisWorkbook.Worksheets
For Each y In x.UsedRange
For Each Z In CheckRange
If y.Formula Like "*" & Z.Address(1, 1) & "*" _
Or y.Formula Like "*" & Z.Address(0, 1) & "*" _
Or y.Formula Like "*" & Z.Address(1, 0) & "*" _
Or y.Formula Like "*" & Z.Address(0, 0) & "*" _
Then Exit Function
Next
Next
Next
RefCheck = False
End Function
あとは調べて無いけど同一シート内で参照していた場合もブック名とシート名を表示させる事が出来れば、
Addressの第四引数にTrue入れてチェックする事で間違いなく判定出来る。
| - Excel VBA 質問スレ Part39 [転載禁止]©2ch.net
509 ：デフォルトの名無しさん[sage]：2016/01/21(木) 06:18:36.49 ID:0jk7vnPh - >>508
Sub test()
Dim a(1 To 5), str(5), b() As String, index As Long
For i = 1 To 5
a(i) = Range(Cells(1, i), Cells(Rows.Count, i).End(xlUp)).Value
Next
For Each v1 In a(1): str(1) = v1
For Each v2 In a(2): str(2) = v2
For Each v3 In a(3): str(3) = v3
For Each v4 In a(4): str(4) = v4
For Each v5 In a(5): str(5) = v5
c = ""
For Each x In str
c = c & x
Next
ReDim Preserve b(index)
b(index) = c
index = index + 1
Next:Next:Next:Next:Next
For Each x In b
Debug.Print x
Next
End Sub
五桁固定。最低でも一桁当り2要素ないといけない。
桁数まで柔軟にすると、くっそ面倒だから自分でやれ。
| - Excel VBA 質問スレ Part39 [転載禁止]©2ch.net
524 ：デフォルトの名無しさん[sage]：2016/01/21(木) 20:35:34.37 ID:0jk7vnPh - >>521
Sub test()
Dim c(2), m As Collection, del As Range
Do
Set del = Nothing
Set m = New Collection
xdata = Range(Cells(1, 1), Cells(Rows.Count, 11).End(xlUp)).Value
i = i + 1
If i > UBound(xdata, 1) Then Exit Do
c(0) = xdata(i, 1): c(1) = xdata(i, 6): c(2) = xdata(i, 7)
For j = 1 To UBound(xdata, 1)
If xdata(j, 1) = c(0) And xdata(j, 6) = c(1) And xdata(j, 7) Then m.Add j
Next
If m.Count Then
p = 0
For Each x In m
e = True
If p Then If xdata(p, 8) > xdata(x, 8) Then e = False
If e Then p = x
Next
For Each x In m
If x <> p Then If del Is Nothing Then Set del = Rows(x) Else Set del = Range(del, Cells(x, 1).EntireRow)
Next
If Not del Is Nothing Then del.Delete
End If
Loop
End Sub
これで動かないかな
|
|