Цитата |
---|
artyrH написал: может вам на форум Работа |
Не стоит, это элементарная задача.
Скрытый текст |
---|
Код |
---|
Sub Command1()
Dim Sh As Worksheet, Город As String, eml As String, FileName As String
Dim Result As String
Result = ""
FileName = Get_FileName("Выбираем файл с городами")
Set Sh = Workbooks.Open(FileName).Worksheets(1)
LastRow = Sh.Cells(Sh.Rows.Count, "B").End(xlUp).Row
gr = Sh.Range("B1:B" & LastRow)
Sh.Parent.Close (False)
FileName = Get_FileName("Выбираем файл с ответственными")
Set Sh = Workbooks.Open(FileName).Worksheets(1)
Set C_is = CreateObject("scripting.dictionary")
LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
dx = Sh.Range("A2:C" & LastRow)
Sh.Parent.Close (False)
eml = ""
For n = 1 To UBound(dx)
Город = dx(n, 1)
If dx(n, 3) <> "" Then eml = dx(n, 3)
C_is.Item(Город) = eml
Next
For n = 2 To UBound(gr)
Город = gr(n, 1)
If Город <> "" Then
If C_is.Exists(Город) Then
eml = C_is.Item(Город)
If InStr(1, Result, eml, vbTextCompare) = 0 Then
Result = IIf(Result = "", eml, Result & ";" & eml)
End If
End If
End If
Next
MsgBox Result
End Sub
Function Get_FileName(Optional ByVal Title As String = "Выберите файл для обработки", _
Optional ByVal FilterDescription As String = "Файлы Excel", _
Optional ByVal FilterExtention As String = "*.xls*") As String
On Error Resume Next
With Application.FileDialog(msoFileDialogOpen) '
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
.Filters.Clear: .Filters.Add FilterDescription, FilterExtention
If .Show <> -1 Then Exit Function
Get_FileName = .SelectedItems(1)
End With
End Function
|
|