napisał: jalamas
postów: 316
 umieszczony:
28 czerwca 2007
09:50
|
|
A istotą tego rozwiąznia jest nie tylko to, że jest w tablicy (szybciej), lecz także IsError, a nie Find jakiekolwiek by nie były argumenty Find
Cytat:ErrArr = Array("#DIV/0!", "#N/A!"....
które nieustająco dołączałeś w takiej czy innej wersji:
Cytat:dtrng.Find(ele, , xlValues, xlWhole
bo powyższe może być źródłem niewłaściwej identyfikacji , co jeszcze raz powtarzam
Cytat:ale nie tędy droga.
Miłej pracy. |
|
|
napisał: LAnd
postów: 107
umieszczony:
28 czerwca 2007
01:43
 edytowany:
28 czerwca 2007
01:51
|
|
tak się zascukałem sprawdzaniem niżej opisanych wersji że zapomniałem o sugesti r_c sprawdzić tablicę
i BRAWOOO !!!
dopalacz 00:00:01
Sub testDopalacz()
Debug.Print KomorkiZBledamiAdresyDopalacz(ActiveSheet)
End Sub
Function KomorkiZBledamiAdresyDopalacz(WSh As Worksheet) As String
'używa funkcji : ObszarDanych i SaKomorkiZBledami
Dim DataRngAdr, tmpWb As Workbook, oldCalc, oldScrUpd, pocz, TmpSh As Worksheet
Dim Maxid1, Maxid2, i1, i2, rv, ttt
pocz = Now 'linia testowa usunąc
DataRngAdr = ObszarDanych(WSh)
If Len(DataRngAdr) < 1 Then Exit Function
If Not SaKomorkiZBledami(WSh) Then Exit Function
ttt = WSh.Range(DataRngAdr)
Maxid2 = UBound(ttt, 2)
Maxid1 = UBound(ttt, 1)
For i1 = 1 To Maxid1
For i2 = 1 To Maxid2
If IsError(ttt(i1, i2)) Then rv = rv & "," & Cells(i1, i2).Address(False, False)
Next
Next
KomorkiZBledamiAdresyDopalacz = Mid(rv, 2)
Debug.Print "dopalacz "; CDate(Now - pocz) 'linia testowa usunąc
End Function |
|
|
napisał: LAnd
postów: 107
umieszczony:
27 czerwca 2007
22:46
|
|
dane miałem na arkuszu o nazwie "test"
przegladałem coś na arkuszu o nazwie "Arkusz2"
i uruchomiłem twoją procedurę test
zdziwiłem się że wykonanie funkcji Find nie zgłosiło błędu bo zapis [A1] ( bez kropki) był interpretowany jako adres ActiveSheet ("Arkusz2") więc z innego arkusza niż arkusz wskazywany przez objWSh ("test"). i to wszystko. |
|
|
napisał: jalamas
postów: 316
umieszczony:
27 czerwca 2007
22:29
edytowany:
27 czerwca 2007
22:36
|
|
| ... |
|
|
napisał: LAnd
postów: 107
umieszczony:
27 czerwca 2007
22:26
|
|
połączenie kopi danych do tablicy i wklejenia w nowy arkusz
ogromne dzięki za współpracę
zaskoczyło mnie .[A1] w Find - kupuję
we wszystkich procedurach ostrzeżenie że jest to wesja robocz z ograniczoną obsługą błędów
wiersze zablokować lub wykasować
zakres danych A1:P41266 komórki z błędami dopisano na końcu
iteracja 00:00:10
turbo 00:00:03
kopia 00:00:08 do schowka zapisuje z formatami a wartości do wklejania wydłubuje
find 00:00:13 'dwa razy obiega dane dla każdego rodzaju błędu
'iteracja =======================================================================
Sub TestIteracja()
Dim lngRes As Long, pocz
pocz = Now
lngRes = CountIsError(ThisWorkbook.Sheets("test")) 'ThisWorkbook.Worksheets(1))
Debug.Print "iteracja "; CDate(Now - pocz)
MsgBox lngRes
End Sub
'CountIsError jak w poście z kropką przed .[A1]
'kopiowanie =======================================================================
Sub testKopia()
Debug.Print KomorkiZBledamiAdresy(ThisWorkbook.Sheets("test"))
End Sub
Function KomorkiZBledamiAdresy(WSh As Worksheet) As String
Dim DataRngAdr, tmpWb As Workbook, oldCalc, oldScrUpd, pocz
pocz = Now
MsgBox "wersja robocza nie obsługuje błędów"
Exit Sub
DataRngAdr = ObszarDanych(WSh)
If Len(DataRngAdr) < 1 Then Exit Function
If SaKomorkiZBledami(WSh) Then Exit Function
' oldScrUpd = Application.ScreenUpdating: Application.ScreenUpdating = False
' oldCalc = Application.Calculation: Application.Calculation = xlCalculationManual
Set tmpWb = Workbooks.Add(xlWBATWorksheet)
WSh.Range(WSh.Cells(1, 1), WSh.Range(DataRngAdr)).Copy
tmpWb.Sheets(1).Cells(1, 1).PasteSpecial xlPasteValues
KomorkiZBledamiAdresy = KomorkiZbledami(tmpWb.Sheets(1))
tmpWb.Close False
' Application.ScreenUpdating = oldScrUpd
' Application.Calculation = oldCalc
Debug.Print "kopia "; CDate(Now - pocz)
End Function
'*************** wspólne kopia i turbo ***********************************
Function KomorkiZbledami(WSh As Worksheet) As String
Dim RetVal As String
On Error Resume Next
RetVal = WSh.Cells.SpecialCells(xlCellTypeConstants, xlErrors).Address
RetVal = RetVal & IIf(Len(RetVal) > 0, ",", "") & WSh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Address
On Error GoTo 0
KomorkiZbledami = RetVal
End Function
Function SaKomorkiZBledami(WSh As Worksheet) As Boolean
Dim Blad
Set Blad = Nothing
On Error Resume Next
Blad = Application.Worksheet.Function.Sum(WSh.Cells)
On Error GoTo 0
SaKomorkiZBledami = IsObject(Blad)
End Function
Function ObszarDanych(WSh As Worksheet) As String
Dim LewaKolumna As Integer, PrawaKolumna As Integer, GornyWiersz As Long, DolnyWiersz As Long
With WSh.Cells
On Error Resume Next
LewaKolumna = .Find("?", , xlValues, xlPart, xlByColumns, xlNext).Column
On Error GoTo 0
If LewaKolumna < 1 Then Exit Function
GornyWiersz = .Find("?", , xlValues, xlPart, xlByRows, xlNext).Row
PrawaKolumna = .Find("?", .Cells(1, 1), xlValues, xlPart, xlByColumns, xlPrevious).Column
DolnyWiersz = .Find("?", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious).Row
ObszarDanych = .Range(.Cells(GornyWiersz, LewaKolumna), .Cells(DolnyWiersz, PrawaKolumna)).Address(False, False, xlA1, , .Cells(GornyWiersz, LewaKolumna))
' ObszarDanych = .Range(.Cells(GornyWiersz, LewaKolumna), .Cells(DolnyWiersz, PrawaKolumna)).Offset(-GornyWiersz + 1, -LewaKolumna + 1).Address(False, False, xlA1, , .Cells(GornyWiersz, LewaKolumna))
End With
End Function
'turbo ================================================================================================
Sub testTrubo()
Debug.Print KomorkiZBledamiAdresyTurbo(ThisWorkbook.Sheets("test"))
End Sub
Function KomorkiZBledamiAdresyTurbo(WSh As Worksheet) As String
Dim DataRngAdr, tmpWb As Workbook, oldCalc, oldScrUpd, pocz, TmpSh As Worksheet
MsgBox "wersja robocza nie obsługuje błędów"
Exit Sub
pocz = Now
DataRngAdr = ObszarDanych(WSh)
If Len(DataRngAdr) < 1 Then Exit Function
If Not SaKomorkiZBledami(WSh) Then Exit Function
Set TmpSh = WSh.Parent.Sheets.Add
ttt = WSh.Range(DataRngAdr)
TmpSh.Cells.Resize(UBound(ttt, 1), UBound(ttt, 2)) = ttt
KomorkiZBledamiAdresyTurbo = KomorkiZbledami(TmpSh)
Application.DisplayAlerts = False
TmpSh.Delete
Application.DisplayAlerts = True
Debug.Print "turbo 1"; CDate(Now - pocz)
End Function
'Find ================================================================================================
Sub szukaj()
Dim fndcel As Range, ErrArr, ele, pocz, DataRngAdr, dtrng As Range, firstAddress
MsgBox "wersja robocza nie obsługuje błędów"
Exit Sub
ErrArr = Array("#DIV/0!", "#N/A", "#NAME?", "#NULL!", "#NUM!", "#REF!", "#VALUE!")
pocz = Now
DataRngAdr = ObszarDanych(ActiveSheet)
If Len(DataRngAdr) < 1 Then Exit Sub
Set dtrng = Range(DataRngAdr)
For Each ele In ErrArr
Set fndcel = dtrng.Find(ele, , xlValues, xlWhole)
If Not fndcel Is Nothing Then
firstAddress = fndcel.Address
Do
If IsError(fndcel.Value) Then Debug.Print fndcel.Address; " "; ele
Set fndcel = dtrng.FindNext(fndcel)
Loop While Not fndcel Is Nothing And fndcel.Address <> firstAddress
End If
Next
Debug.Print "find "; CDate(Now - pocz)
End Sub |
|
|
napisał: LAnd
postów: 107
umieszczony:
27 czerwca 2007
19:00
edytowany:
27 czerwca 2007
19:04
|
|
owocna współpraca wersję turbo opublikuję po testach z Find
dzieki przykładom wyszło mi że wartość szukana w VBA dla błędu to jego angielska wyświetlana nazwa co wymaga wykonania sprawdzen dla kilku wartości
With objWSh
LastRow = .Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
program nie zgłosił błędu pomimi że był aktywny o nazwie "Arkusz2" a nie "test" , przypadkowo |
|
|
napisał: jalamas
postów: 316
umieszczony:
27 czerwca 2007
17:55
|
|
| Nie do pogardzenia, prawda. |
|
|
napisał: r_c
postów: 38
umieszczony:
27 czerwca 2007
13:11
|
|
Wydaje się, że nie do pogardzenia jest przetworzenie zawartości arkusza przy użyciu dwuwymiarowej tablicy typu Variant:
- wczytanie zawartości arkusza odbywa się prawie natychmiast;
- odczyt tablicy jest również szybki;
- na podstawie indeksów tablicy b.łatwo jest ustalić adres komórki.
odczyt:
If IsError(TABLICA(WIERSZ, KOLUMNA)) Then
MsgBox CStr(Cells(WIERSZ, KOLUMNA).Value) & " - " & Cells(WIERSZ, KOLUMNA).Address
End If
lub
If Cstr(TABLICA(WIERSZ, KOLUMNA))="Error 2029" Then
MsgBox "Błąd " & Cells(WIERSZ, KOLUMNA).Address
End If
lub użycie operatora Like i maski znaków lub .... .
Adresowanie dla początku zakresu wg zasady: WIERSZ + (nr wiersza komórki-1), a KOLUMNA + (nr kolumny komórki -1).
pzdr r_c |
|
|
napisał: LAnd
postów: 107
umieszczony:
27 czerwca 2007
08:31
|
|
ponieważ SpecialCells działają na arkuszu nie zablokowanym to
1. sprawdzić czy są błędy , będzie szybko szybko
2, utworzyć nowy arkusz - dość szybko
3. wykonać kopię danych do nowego arkusza - trzeba zmierzyć czas
4. da się na nim wykonać SpecialCells i zapamiętać wynik - będzie szybko
5. usunąć nowy arkusz - będzie szybko
teraz sprawdzam czy ta procedura będzie szybsza od iteracyjnego wyszukiania błędu |
|
|
napisał: jalamas
postów: 316
umieszczony:
26 czerwca 2007
21:12
|
|
Akurat #NAZWA?, przypuszczam:
Set TmpCell = .Find(What:="#NAME?", After:=komorka_poczatkowa, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
ale nie tędy droga.... przy innych błędach.
Jest to w zacytowanej procedurze w moim poprzednim poście Case xlErrName.
Jeśli Ci zależy na tym tylko warunku, możesz "rozdzielić" lub wyeliminować przypadki w Case.
Zatem może inaczej, powiedz co w moim przykładzie nie spełnia Twoich wymagań, czego ja nie zauważyłam.
Nie denerwuj się Andrzejku, na pewno problem jakoś da się rozwiązać, ja zapewne nie do końca rozumiem Twojego pytania 
Nie upierałabym się przy Find. |
|
|
napisał: LAnd
postów: 107
umieszczony:
26 czerwca 2007
10:10
edytowany:
27 czerwca 2007
07:21
|
|
zjadłem na początku "jak"
w.dzięki za zainteresowanie
sprawa dotyczy importu przez sieć danych pomiarowych
zdarza się że zaczytane wartości do komórek sforamtownych ogólnie dla Excela są podobne do formuł i wtedy błąd #NAZWA?
Jak te cholery zlokalizować na zabezpieczonym arkuszu
najlepiej Find(??????,,????,???,) ale jaki argument lub argumenty użyć
w sieci na razie nie znalazłem
Pzdrw
na odblokowany rzeczywiście można
Function KomorkiZbledami(WSh As Worksheet) As String
Dim RetVal As String
On Error Resume Next
RetVal = WSh.Cells.SpecialCells(xlCellTypeConstants, xlErrors).Address
'poprawka 2007-06-27 bo jak nie znajdzie stałych błędów to wynik zaczynałby się od przecinka
' RetVal = RetVal & "," & WSh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).addres
RetVal = RetVal & Iif(Len(RetVal)>0 , "," , "") & WSh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).addres
On Error GoTo 0
KomorkiZbledami = RetVal
End Function |
|
|
napisał: jalamas
postów: 316
umieszczony:
26 czerwca 2007
07:54
|
|
Nie do końca rozumiem pytanie, nie wiem czy w jest to pytanie, czy komuś odpowiadasz ?
Jeżeli to jest pytanie, rozumiem, że bez zdejmowania ochrony, bo też tego nie zaznaczyłeś ?
To może tak:
Sub Test()
Dim lngRes As Long
lngRes = CountIsError(ThisWorkbook.Worksheets("test"))
MsgBox lngRes
End Sub
Public Function CountIsError(objWSh As Worksheet) As Long
On Error GoTo CountIsError_Error
' jezeli tylko sprawdzic czy sa bledy po 1-szym mozna zakonczyc
Dim LastCol As Long
Dim LastRow As Long
Dim TmpCell As Range
Dim Rng As Range
Dim iErr As Long
With objWSh
If Application.WorksheetFunction.CountA(.Cells) > 0 Then
LastRow = .Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set Rng = .Cells(1, 1).Resize(RowSize:=LastRow, ColumnSize:=LastCol)
Else
Exit Function
End If
End With
With Rng
For Each TmpCell In .Cells
If IsError(TmpCell.Value) Then
' nie wiem czy ten Case jest potrzebny zapytaj Rysia
' chyba wystarczy samo: iErr = iErr + 1
Select Case CLng(TmpCell.Value)
Case xlErrDiv0, xlErrNA, xlErrName, xlErrNull, _
xlErrNum, xlErrRef, xlErrValue
iErr = iErr + 1
Case Else
MsgBox "????? "
End Select
End If
Next
End With
CountIsError = iErr
CountIsError_Exit:
On Error Resume Next
Set TmpCell = Nothing: Set Rng = Nothing
Exit Function
CountIsError_Error:
MsgBox "Błąd : ( " & Err.Number & " ) " & Err.Description & vbCrLf & _
"Procedura : " & "CountIsError", vbExclamation
Resume CountIsError_Exit
End Function
Bo jesli można wziąć pod uwagę zdjęcie ochrony, to można od razu wyznaczyć unię komórek z błędami ?
Info:
Na stronie
http://support.microsoft.com/kb/146864
punkt: Using Built-In Error Values
Rozważania o Last Cell itd… tutaj:
http://www.ozgrid.com/VBA/ExcelRanges.htm
http://microsoft-personal-applications.hostweb.com/TopicMessages/microsoft.public.excel.worksheet.functions/1984111/2/Default.aspx
P.S.
Cytat:Application.worksheet.function -- > Application.WorksheetFunction |
|
|
napisał: LAnd
postów: 107
umieszczony:
26 czerwca 2007
01:48
|
|
jakie argumenty do
cells.find(????,,xlvalues,xlwhole)
lub
application.worksheet.function.countif(cells,?????)
moje :
Function SaKomorkiZBledami() as boolean
Dim Blad
set Blad=Nothing
on error resume next
Blad=application.worksheet.function.sum(cells)
on error goto 0
SaKomorkiZBledami=isobject(Blad)
end function |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
|
