Ako priklad sem vlozim kod ktory som si napisal na hladanie viacnasobnych zaznamov.. teda ak v stlpci 15 v harku Data najde jeden zaznam viac krat skopiruje cely riadok s tymto zaznamom a vypise do ineho harku..
Co chcem je, aby som mohol prehladavane data z harku data mat v uzavretom xlsx, alebo xlsb subore a mohol s nimi pracovat ako doteraz.. teda aby mi toto makro mohlo stade kopirovat riadky a vkladat do otvoreneho workbooku v ktorom sa nachadza dane makro..
Z casti som nasiel riesenie cez funkciu executeexcel4macro(), no tato funkcia nevie vratit rozsah stlpca C15, ktory potrebujem pre funkciu countif..
Preto budem rad za akekolvek odkazy na miesta, kde by som nasiel odpoved na dany problem, pripadne daky navrh na riesenie...
Moj kod (vsimnite si len co riesim, adresovanie rozsahu su zatial len moje neuspesne pokusy):
Kód: Vybrat vše
Private Sub CommandButton1_Click()
Dim hod As String
Dim bunka As String
Dim i As Long
Dim j As Integer
Dim vyber As Range
Dim ciel As Range
Dim rozsah As String
Dim rozsah2 As Long
j = 5
p = "C:\Documents and Settings\quality\Desktop\Ivan S\Tests of external data source"
f = "DATA.xlsx"
s = "Raw data new models"
For i = 1 To 100000
a = Cells(i, 15).Address
bunka = arg(p, f, s, a)
bunka2 = ExecuteExcel4Macro(bunka)
Cells(3, 3) = bunka2
If bunka = "" Then
Cells(3, 3) = "Done"
MsgBox "Hotovo.. Pocet najdenych zaznamov: " & j - 5
Exit Sub
End If
rozsah = "'C:\Documents and Settings\quality\Desktop\Ivan S\Tests of external data source\[DATA.xlsx]Raw data new models'!C15"
rozsah2 = ExecuteExcel4Macro(rozsah)
Cells(5, 2) = Application.CountIf(rozsah2, bunka)
Cells(3, 2) = i
If hod > 1 Then
j = j + 1
a = Cells(i, 1)
Set vyber = GetValue(p, f, s, a)
vyber.EntireRow.Copy
Set ciel = Cells(j, 1)
ciel.EntireRow.PasteSpecial
End If
Next i
Set vyber = Nothing
Set ciel = Nothing
End Sub
Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
Cells(4, 2) = arg
GetValue = ExecuteExcel4Macro(arg)
End Function
Private Function arg(path, file, sheet, ref)
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue2 = "File Not Found"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1)
Cells(4, 3) = arg
'GetValue2 = ExecuteExcel4Macro(arg)
End Function
Private Sub CommandButton2_Click()
End Sub