Добрый день всем! Столкнулся с проблемой, которую не могу решить. Есть куча форм, которые надо заполнять. Часть информации в формах повторяется. Поэтому решил загнать все формы в листы Excel, а первым листом сделать базу. И при двойном клике по ячейке "С1" (например) заполнять формы по столбцу "С". Но вот беда... если в формах есть одинаковые данные (поля), то заполняются только первые... последующие, по каким то мне неведанным причинам, не заполнятся. Присвоить двум разным ячейкам одно имя не excel не дает, прямые ссылки вида "=MyCellName", не срабатывают.
Как быть не знаю. Excel и VBA изучаю самостоятельно методом проб и ошибок. Информации по данному вопросу не нашел, возможно не правильно сформулировал запрос в поиске. Одним словом, если кто подскажет как быть, буду очень благодарен!
В приложении пример файла с формами и макросом.
На всякий случай приведу код макроса. [vba]
Код
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Row = 1 And Target.Column > 2 Then Cancel = True 'close cell Debug.Print "ïîäñòàíîâêà" 'Debug.Print Target.Column Call AutoWork(Target.Column) End If End Sub Sub AutoWork(Column) Application.ScreenUpdating = False Dim iColl As Long Dim iArr As Variant Dim iRow As Integer Dim iSh As Integer Dim iName As String
For iSh = 2 To Sheets.Count For iRow = 2 To 32 Sheets(iSh).Activate iName = Sheets("Реестр").Cells(iRow, "B") Debug.Print iName If Not Range(iName) Is Nothing Then Debug.Print "Нашли" Range(iName) = Sheets("Реестр").Cells(iRow, Column) Else Debug.Print "Не нашли" End If Next iRow Next iSh Application.ScreenUpdating = True End Sub
[/vba]
Добрый день всем! Столкнулся с проблемой, которую не могу решить. Есть куча форм, которые надо заполнять. Часть информации в формах повторяется. Поэтому решил загнать все формы в листы Excel, а первым листом сделать базу. И при двойном клике по ячейке "С1" (например) заполнять формы по столбцу "С". Но вот беда... если в формах есть одинаковые данные (поля), то заполняются только первые... последующие, по каким то мне неведанным причинам, не заполнятся. Присвоить двум разным ячейкам одно имя не excel не дает, прямые ссылки вида "=MyCellName", не срабатывают.
Как быть не знаю. Excel и VBA изучаю самостоятельно методом проб и ошибок. Информации по данному вопросу не нашел, возможно не правильно сформулировал запрос в поиске. Одним словом, если кто подскажет как быть, буду очень благодарен!
В приложении пример файла с формами и макросом.
На всякий случай приведу код макроса. [vba]
Код
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Row = 1 And Target.Column > 2 Then Cancel = True 'close cell Debug.Print "ïîäñòàíîâêà" 'Debug.Print Target.Column Call AutoWork(Target.Column) End If End Sub Sub AutoWork(Column) Application.ScreenUpdating = False Dim iColl As Long Dim iArr As Variant Dim iRow As Integer Dim iSh As Integer Dim iName As String
For iSh = 2 To Sheets.Count For iRow = 2 To 32 Sheets(iSh).Activate iName = Sheets("Реестр").Cells(iRow, "B") Debug.Print iName If Not Range(iName) Is Nothing Then Debug.Print "Нашли" Range(iName) = Sheets("Реестр").Cells(iRow, Column) Else Debug.Print "Не нашли" End If Next iRow Next iSh Application.ScreenUpdating = True End Sub
Может еще подскажите... Пока вчера перебирал варианты, заметил такой косяк. Если в книге нет ячейки с искомым именем, то код падает с ошибкой в строке [vba]
Код
If Not Range(iName) Is Nothing Then
[/vba] не подскажите как организовать пропуск и дальнейший перебор... пробовал вариант с [vba]
Код
On Error GoTo Next iRow
[/vba] Cразу после If, но все равно не работает...
Спасибо! Заработало!
Может еще подскажите... Пока вчера перебирал варианты, заметил такой косяк. Если в книге нет ячейки с искомым именем, то код падает с ошибкой в строке [vba]
Код
If Not Range(iName) Is Nothing Then
[/vba] не подскажите как организовать пропуск и дальнейший перебор... пробовал вариант с [vba]
Код
On Error GoTo Next iRow
[/vba] Cразу после If, но все равно не работает...Benos
'... On Error GoTo A If Not Range(iName) Is Nothing Then Debug.Print "Нашли" Range(iName) = Sheets("Реестр").Cells(iRow, Column) Else Debug.Print "Не нашли" End If A: Next iRow
[/vba]
А так если [vba]
Код
'... On Error GoTo A If Not Range(iName) Is Nothing Then Debug.Print "Нашли" Range(iName) = Sheets("Реестр").Cells(iRow, Column) Else Debug.Print "Не нашли" End If A: Next iRow
Sub AutoWork(Column) Dim iColl As Long Dim iArr As Variant Dim iRow As Integer Dim iSh As Integer Dim iName As String Dim r As Range
Application.ScreenUpdating = False
On Error Resume Next: Err.Clear For iSh = 2 To Sheets.Count For iRow = 2 To 32 Sheets(iSh).Activate iName = Sheets("Реестр").Cells(iRow, "B") Set r = Range(iName) If Err Then MsgBox "не нашли " & iName, 48 Err.Clear Else Range(iName) = Sheets("Реестр").Cells(iRow, Column) 'нашли End If Next iRow Next iSh Application.ScreenUpdating = True End Sub
[/vba]
Попробуйте как-то вот так:
[vba]
Код
Sub AutoWork(Column) Dim iColl As Long Dim iArr As Variant Dim iRow As Integer Dim iSh As Integer Dim iName As String Dim r As Range
Application.ScreenUpdating = False
On Error Resume Next: Err.Clear For iSh = 2 To Sheets.Count For iRow = 2 To 32 Sheets(iSh).Activate iName = Sheets("Реестр").Cells(iRow, "B") Set r = Range(iName) If Err Then MsgBox "не нашли " & iName, 48 Err.Clear Else Range(iName) = Sheets("Реестр").Cells(iRow, Column) 'нашли End If Next iRow Next iSh Application.ScreenUpdating = True End Sub