Макрос для отбора данных

[dyakon88]

Еще вопрос, помогите пожалуйста, как сделать с помощью SQL-запроса

Option Explicit
Sub Макрос2()
Dim a(), b(), Lr As Long, i As Long, ii As Long
' Макрос2 Макрос
'
'
With ActiveSheet.ListObjects.Add(SourceT ype:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Documents and Settings\Юзер\Рабочий стол\excel\пример.xlsx;DefaultDir=C :\Documents and Settings\Юзер\Раб" _
), Array("очий стол\excel;DriverId=1046;MaxBufferS ize=2048;PageTimeout=5;")), _
Destination:=Range("$A$1")).QueryTa ble
With Sheets(2)
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
b = .Range("a1:b" & Lr).Value
End With

For i = 1 To UBound(b)
s=(`Лист1$`.`лиц счет`=i)
Next ii, i
.CommandText = Array( _
"SELECT `Лист1$`.`лиц счет`, `Лист1$`.фамилия" & Chr(13) & "" & Chr(10) & "FROM `C:\Documents and Settings\Юзер\Рабочий стол\excel\пример.xlsx`.`Лист1$` `Лист1$`" & Chr(13) & "" & Chr(10) & "WHERE (`Лист1$`.`лиц счет`=1.0)" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Таблица_Запрос_из_Excel_Files"
.Refresh BackgroundQuery:=False
End With
End Sub

какие тут ошибки,и что надо добавить?

[Hugo121]

Вот это вообще непонятно что

For i = 1 To UBound(b)
s=(`Лист1$`.`лиц счет`=i)
Next ii, i

ii тут явно лишнее, остальное не понял...

[dyakon88]

какое условие написать надо в команде тексте

Sub Макрос2()
Dim a(), b(), Lr As Long, i As Long, ii As Long, s As String

' Макрос2 Макрос
'
'
With ActiveSheet.ListObjects.Add(SourceT ype:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Documents and Settings\Юзер\Рабочий стол\excel\пример.xlsx;DefaultDir=C :\Documents and Settings\Юзер\Раб" _
), Array("очий стол\excel;DriverId=1046;MaxBufferS ize=2048;PageTimeout=5;")), _
Destination:=Range("$A$1")).QueryTa ble
With Sheets(2)
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
b = .Range("a1:b" & Lr).Value
End With
For i = 1 To UBound(b)
s = s & "(`Лист1$`.`лиц счет`=" & i & ")"
's = " & "
Next i
.CommandText = Array("SELECT `Лист1$`.`лиц счет`, `Лист1$`.фамилия" & Chr(13) & "" & Chr(10) & "FROM `C:\Documents and Settings\Юзер\Рабочий стол\excel\пример.xlsx`.`Лист1$` `Лист1$`" & Chr(13) & "" & Chr(10) & "WHERE (" & s) Or (" ) ")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Таблица_Запрос_из_Excel_Files"
.Refresh BackgroundQuery:=False
End With
End Sub

[dyakon88]

как написать код, чтоб при запуске макроса лист очищался

[EugeneS]

могу Вам предложить такой вариант с иcпользованием SQL:

Предварительнно необходимо подключить библиотеку: Alt+F11 - Tools - References - Microsoft ActiveX Data Object 2.0 (или выше)
Будучи на Листе1, запустите макрос "Отбор"

Sub Отбор()
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset: Application.ScreenUpdating = False
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ";Extended Properties=""Excel 8.0;HDR=No;"";"
rs.Open "SELECT T2.F1,(SELECT T1.F2 FROM [Лист1$A2:B65536] T1 WHERE T1.F1=T2.F1) FROM [Лист2$A2:A65536] T2", cn, adOpenStatic, adLockReadOnly
With Sheets(3): .Activate: [b:b].Clear: [a2].CopyFromRecordset rs: Set rs = Nothing: Set cn = Nothing: End With: End Sub

[dyakon88]

Сообщение от EugeneS

могу Вам предложить такой вариант с иcпользованием SQL:

Предварительнно необходимо подключить библиотеку: Alt+F11 - Tools - References - Microsoft ActiveX Data Object 2.0 (или выше)
Будучи на Листе1, запустите макрос "Отбор"

Sub Отбор()
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset: Application.ScreenUpdating = False
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ";Extended Properties=""Excel 8.0;HDR=No;"";"
rs.Open "SELECT T2.F1,(SELECT T1.F2 FROM [Лист1$A2:B65536] T1 WHERE T1.F1=T2.F1) FROM [Лист2$A2:A65536] T2", cn, adOpenStatic, adLockReadOnly
With Sheets(3): .Activate: [b:b].Clear: [a2].CopyFromRecordset rs: Set rs = Nothing: Set cn = Nothing: End With: End Sub

библиотеку поставил, но выдает ошибку на [Лист1$A2:B65536]

[EugeneS]

Excel 2003

[dyakon88]

как написать код в макросе, чтоб при каждом запуске макроса лист очищался(то есть удалялись все записи и формат)

[EugeneS]

можно так

ActiveSheet.Cells.Clear

быстрее очистить известный диапазон, например по колонкам:

[a:v].clear

[dyakon88]

Помогите пожалуйста, как сделать в условие WHERE чтоб строчка прибавлялась...

Option Explicit
Sub Макрос2()
Dim a(), b(), Lr As Long, i As Long, ii As Long, s As String

' Макрос2 Макрос
'
'
With ActiveSheet.ListObjects.Add(SourceT ype:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Documents and Settings\Юзер\Рабочий стол\excel\пример.xlsx;DefaultDir=C :\Documents and Settings\Юзер\Раб" _
), Array("очий стол\excel;DriverId=1046;MaxBufferS ize=2048;PageTimeout=5;")), _
Destination:=Range("$A$1")).QueryTa ble


With Sheets(2)
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
b = .Range("a1:b" & Lr).Value
End With
For i = 1 To UBound(b)
s = s & "(`Лист1$`.`лиц счет`=" & i & ")"
's = " & "
Next i
.CommandText = Array("SELECT `Лист1$`.`лиц счет`, `Лист1$`.фамилия" & Chr(13) & "" & Chr(10) & "FROM `C:\Documents and Settings\Юзер\Рабочий стол\excel\пример.xlsx`.`Лист1$` `Лист1$`" & Chr(13) & "" & Chr(10) & "WHERE (" & s) Or (" s) ")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Таблица_Запрос_из_Excel_Files"
.Refresh BackgroundQuery:=False
End With
End Sub