Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Ustalenie ostatniego wiersza w kolumnie w zamkniętym pliku

Leon M · Fan Excela Wersja: Win Office 2010 Posty: 97

Szanowni Forumowicze, kieruję prośbę do Was o pomoc w następującej kwestii:

W zamkniętym skoroszycie źródłowym jest tabela o zmiennej ilości wierszy. Jak uzyskać numer ostatniego wiersza tej tabeli za pomocą odpowiedniego kodu VBA z poziomu skoroszytu wynikowego?

Zamieszczone w załączniku przykładowe pliki obrazują kwestię.

Z góry pięknie dziękuję za wszystkie odpowiedzi.

Demo11.rar

Pobierz Plik ściągnięto 5 raz(y) 22.06 KB

umiejead · Wysłany: 20-02-2021, 21:26

Ustaw odpowiednią ścieżkę.

Kod:

Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim strPath As String
Dim d As Long

Application.ScreenUpdating = False
strPath = "L:\Baza1.xlsx"
Set wb = Workbooks.Open(strPath)
d = wb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
wb.Close False
Application.ScreenUpdating = True

MsgBox d

End Sub

Marecki · Wysłany: 20-02-2021, 21:45

To zamieńmy funkcję

Kod:

Option Explicit

Sub Pobieranie()
Dim vArr() As Variant
Dim p$, f$, s$, r$

p = "g:\Roboczy 3\"
f = "Baza1.xlsx"
s = "Arkusz1"
r = Columns(1).Address(False, False)
vArr = ADOGetValue(p, f, s, r)

Range("E2").Resize(UBound(vArr)).Value = vArr

End Sub

'http://www.excelforum.pl/topics3/funkcja-getvalue-vt12354.htm?postdays=0&postorder=asc&highlight=%2Aadogetvalue%2A&start=0
Function ADOGetValue(path As String, file As String, sheet As String, ref As String)
' =ADOGetValue(p;f;s;r)
' p - scieżka
' f - nazwa pliku
' s - nazwa arkusza
' r - komórka lub obszar np. "A3", "A1:A10"
Dim arg As String
Dim nRowCount As Long, nColCount As Long
Dim nActRow As Long, nActCol As Long
Dim ArrVal() As Variant
Dim xArray As Variant
Dim xValue As Variant
Dim strConnectionString As String
Dim oCn As Object, oRs As Object

On Error GoTo ADOGetValue_Error

If Right(path, 1) <> "\" Then path = path & "\"

If Dir(path & file) = "" Then
'brak pliku ...
ADOGetValue = CVErr(2042)
Exit Function
End If

Set oCn = CreateObject("ADODB.Connection")

If Val(Application.Version) < 12 Then
strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & path & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""
Else
strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & path & file & ";" & _
"Extended Properties=""Excel 12.0;HDR=NO;IMEX=1;"""
End If

oCn.Open strConnectionString
arg = "select * from [" & sheet & "$" & ref & _
IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"

Set oRs = CreateObject("ADODB.Recordset")

oRs.Open arg, oCn, 3

xArray = oRs.getRows

nRowCount = UBound(xArray, 2)
nColCount = UBound(xArray, 1)

ReDim ArrVal(1 To nRowCount + 1, 1 To nColCount + 1)

For nActRow = 0 To nRowCount

For nActCol = 0 To nColCount

xValue = xArray(nActCol, nActRow)

If IsNumeric(xValue) Then
xValue = CDbl(xValue)
ElseIf IsNull(xValue) Then
xValue = Empty
End If

ArrVal(nActRow + 1, nActCol + 1) = xValue

Next

Next

ADOGetValue = ArrVal

oRs.Close
oCn.Close

Set oRs = Nothing
Set oCn = Nothing

On Error GoTo 0
Exit Function

ADOGetValue_Error:
ReDim ArrVal(1 To 1, 1 To 1)
ArrVal(1, 1) = vbNullString
ADOGetValue = ArrVal
End Function

Co prawda nie jest to pobranie numeru ostatniego wiersza, ale to żaden problem puścić pętlę po vArr i sprawdzić który element w tablicy jest niepusty jako ostatni.
Np. tak:

Kod:

Sub Pobieranie()
Dim vArr() As Variant
Dim p$, f$, s$, r$, i&, Ans&

p = "g:\Roboczy 3\"
'p = "C:\Users\mkkk2\Downloads\Demo11\"
f = "Baza1.xlsx"
s = "Arkusz1"
r = Columns(1).Address(False, False)
vArr = ADOGetValue(p, f, s, r)

For i = 1 To UBound(vArr)
If VBA.Len(vArr(i, 1)) > 0 Then Ans = i
Next i
MsgBox "Ostatni wierszy w " & f & " to " & Ans

End Sub

Leon M · Fan Excela Wersja: Win Office 2010 Posty: 97

Pięknie dziękuję za przedstawione sposoby rozwiązania przedłożonej kwestii.

Mam pytanie odnośnie fragmentu kodu zaprezentowanego przez Mareckiego:

Kod:

r = Columns(1).Address(False, False)
vArr = ADOGetValue(p, f, s, r)

Zmienna r otrzymuje wartość A:A, czy to skutkuje tym, że do tablicy vArr zostaje przypisana cała kolumna nr 1?

Za odpowiedzi z góry bardzo dziekuję.

Marecki · Wysłany: 21-02-2021, 19:42

Odniesienie jest do całej kolumny, ale jak przejdziesz krokowo przez funkcję to zauważysz że iteracja odbywa się po komórkach kolumny w których jest przechowywana jakaś wartość lub ma jakieś formatowanie