Temat: Excel makro VBA - Importowanie komórek z innego pliku...

Hej, mam problem z moim makrem. Chciałbym zaimportować pewne komórki z innego pliku poprzez makro. Działa już prawie wszystko ok tylko w tych komórkach są daty. Zasięg importu jest większy niż dane które chce ściagnąć z tego względu że co chwila ktoś dodaje nowe wiersze itd. Tak więc gdy zaciągam dane to w moim pliku z makrem w miejsce pustych komórek wyskakuje albo błąd albo data 1900-01-01. Potrzebuje komendy która będzie ściągać puste komórki a nie przekształcało je w błedy lub irracjonalne daty. Przepraszam z góry za mój mało profesjonalny język ale jestem laikiem pod względem makra. Oto moje "cudo":

Private Function GetValue(path, file, sheet, ref) As Variant
' GetValue(p,f,s,r)
' p = "T:\Kontraktorzy\MPP\makro"
' f = "ARTWORK.xlsx"
' s = "DATA-ARTWORK"
' ref = "H2:Q1000"

Dim arg As String
Dim nRow, nCol
Dim nRowCount, nColCount
Dim nActRow, nActCol
Dim ArrVal() As Variant
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
'brak pliku ...
GetValue = CVErr(2042)
Exit Function
End If
nRow = Range(ref).Row
nCol = Range(ref).Column
nRowCount = Range(ref).Rows.Count
nColCount = Range(ref).Columns.Count
ReDim ArrVal(1 To nRowCount, 1 To nColCount)
For nActRow = 1 To nRowCount
For nActCol = 1 To nColCount

arg = "'" & path & _
"[" & file & "]" & _
sheet & "'!" & _
"R" & nRow + nActRow - 1 & _
"C" & nCol + nActCol - 1

ArrVal(nActRow, nActCol) = ExecuteExcel4Macro(arg)
Next
Next
GetValue = ArrVal
End Function

Sub test()
Worksheets("DATA").Activate
p = "T:\Kontraktorzy\MPP\makro"
f = "ARTWORK.xlsx"
s = "DATA-ARTWORK"
Range("W4:AF1000") = GetValue(p, f, s, "H2:Q1000")
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("DATA").Select

Columns("Z:AF").Select
Selection.NumberFormat = "dd-mm-yy"
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
End With
End Sub

Temat: Excel makro VBA - Importowanie komórek z innego pliku...

To całkowicie normalne zachowanie Excela.
Jak do A1 wpiszemy =B1, a B1 jest pustą komórką, to formuła wyświetli zero.
Funkcja zwraca zero, po czym ta wartość zostaje sformatowana jako data, a więc wyświetla się pierwsza możliwa data: 00-01-00.
Kluczem jest zatem sprawdzenie czy wartość przychodząca z funkcji to zero i odpowiednia reakcja podczas wypełniania tablicy.

Private Function GetValue(path, file, sheet, ref) As Variant

' GetValue(p,f,s,r)

' p = "T:\Kontraktorzy\MPP\makro"

' f = "ARTWORK.xlsx"

' s = "DATA-ARTWORK"

' ref = "H2:Q1000"



Dim arg As String

Dim nRow, nCol

Dim nRowCount, nColCount

Dim nActRow, nActCol

Dim ArrVal() As Variant

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

If Dir(path & file) = "" Then

'brak pliku ...

GetValue = CVErr(2042)

Exit Function

End If

nRow = Range(ref).Row

nCol = Range(ref).Column

nRowCount = Range(ref).Rows.Count

nColCount = Range(ref).Columns.Count

ReDim ArrVal(1 To nRowCount, 1 To nColCount)

For nActRow = 1 To nRowCount

For nActCol = 1 To nColCount



arg = "'" & path & _

"[" & file & "]" & _

sheet & "'!" & _

"R" & nRow + nActRow - 1 & _

"C" & nCol + nActCol - 1

t = ExecuteExcel4Macro(arg)

ArrVal(nActRow, nActCol) = IIf(t = 0, "", t)

Next

Next

GetValue = ArrVal

End Function



Sub test()

Worksheets("DATA").Activate

p = "T:\Kontraktorzy\MPP\makro"

f = "ARTWORK.xlsx"

s = "DATA-ARTWORK"

Range("W4:AF1000") = GetValue(p, f, s, "H2:Q1000")

' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False



Sheets("DATA").Select



Columns("Z:AF").Select

Selection.NumberFormat = "dd-mm-yy"

With Selection

.HorizontalAlignment = xlRight

.VerticalAlignment = xlBottom

End With

End Sub

Pozdrawiam!

Temat: Excel makro VBA - Importowanie komórek z innego pliku...

Witam,
Wielkie dzięki za pomoc! Wszystko teraz działa poprawnie.