lextoys,Что бы заработало вам надо: 1) В таблице с данными сделать числа записанные как текст числами 2) В таблице условий записывать дробные числа используя как разделитель целого и дробного "." (Точку) а не "," (запятую)
Option Explicit
Public Sub Фильтр_Копировать_Параллельно()
Dim rng As Range
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error Resume Next
Dim rngInput As Range
Set rngInput = Application.InputBox(Prompt:="Выберите ячейку или введите в формате A1:", Type:=8)
On Error GoTo 0
If Not rngInput Is Nothing Then
Dim СтолбецСмещения
СтолбецСмещения = rngInput.Column - rng.Column
Else
Exit Sub '==>>
End If
Dim eL As Range
For Each eL In rng
eL.Copy
eL.Offset(0, СтолбецСмещения).PasteSpecial xlPasteFormulas
Next
MsgBox "Всё !"
End Sub
Вот эту строку вы изменили неверно. естественно у вас ошибка, ибо нет такого пути Если вам надо сохранять файл по пути "D:\" то она должна выглядеть так
alexexcel1990, Если перенесли код в свой файл без изменений и в ячейке указано корректное для имения файла значение то должно работать. Показывайте файл пример с ошибкой.
Sub savesheet()
Dim wb As Workbook, sName As String, sPath As String
Application.DisplayAlerts = False
sPath = ThisWorkbook.Path & "\" 'Путь по которому сохраняем файл, в данном случае папка где находится книга с макросом
sName = Cells(1, 1).Value 'Имя файла, в данном случае берется из ячейки А1
Set wb = ThisWorkbook
wb.ActiveSheet.Copy
Set wbCopySheet = ActiveWorkbook
wbCopySheet.SaveAs Filename:=sPath & sName & ".xlsx", FileFormat:=51
wbCopySheet.Close
Application.DisplayAlerts = True
End Sub
Дмитрий(The_Prist) Щербаков написал: может у Вас в столбце А и формулы, и текст, и числа и пустые ячейки. А надо добавить только к тексту(игнорируя остальные ячейки).
Sub test()
Dim rRng As Range
Set rRng = Sheets("Лист1").UsedRange.Columns(1).SpecialCells(2)
For Each cl In rRng
cl.Value = "какой то текст " & cl.Value
Next
End Sub
P.S. Вам бы не спорить, а просто показать сразу как выглядят ваши исходные данные и какой должен получится результат в примере, и не было бы никакой головной боли. Возможно я тоже не угадал
evgeniygeo,В циклах присваивайте значения переменной, а после цикла выводите сообщение. Например, для первого блока:
Код
Sub aaa()
a = Date - 1
Set fcell = Columns("A:A").Find(a)
If Not fcell Is Nothing Then
For i = 3 To CStr(fcell.Row)
If Cells(i, 2).Value > 0 Then
sStr = sStr & "вагон1: " & Cells(i, 1).Value & "-" & Cells(i, 2).Value & "мин" & vbCrLf
End If
Next i
MsgBox sStr
End If
End Sub
остальное по аналогии перепишите. Хотя, зачем 4 отдельных цикла, можно весь ваш код примерно так записать
Код
Sub aaa()
a = Date - 1
Set fcell = Columns("A:A").Find(a)
If Not fcell Is Nothing Then
For j = 2 To 5
For i = 3 To CStr(fcell.Row)
If Cells(i, j).Value > 0 Then
sStr = sStr & "вагон" & j - 1 & ": " & Cells(i, 1).Value & "-" & Cells(i, j).Value & "мин" & vbCrLf
End If
Next i
Next j
End If
MsgBox sStr
End Sub
Sub test()
Dim oStream
sFile = "C:\Users\Katalog\Desktop\file.xml"
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Open
.Charset = "utf-8"
For i = 1 To 30
.WriteText Cells(i, 1), 1
Next i
.SaveToFile sFile, 2
End With
Set oStream = Nothing
End Sub
RAN написал: (почему, самому до кончика хвоста любопытно),
Да всё те же заморочки с региональными настройками. Поменяйте в региональных настройках разделитель целой и дробной части с (",") на ("."), и всё будет прекрасно работать. Тема с похожей проблемой, только там с разделителем элементов списка траблы, хотя в этой решение другое )
прошу прощения, вариант предложенный в сообщении 3 от Wild.Godlike Мой вариант не вытащит из колонки С если перед номером счёта не будет стоять знак номера №
Рамиль Камалитдинов написал: То есть вопрос у меня в том как в соседнем столбце в листе EXPORT сделать ячейки содержащие то, что можно сравнивать через ВПР с данными в Базе по номеру счета.