Найти ячейку, начинающуюся с "abc" в строке;вырезать и пройти эту ячейку в столбце с тем же номером строки - PullRequest
0 голосов
/ 08 июля 2019

У меня есть лист с большим количеством данных, каждая строка представляет собой набор информации, к сожалению, эта информация случайно помещается в строку; Я хотел бы собрать адреса в одном столбце. Ячейки, содержащие информацию об адресе, начинаются с «адреса».

Моя первая идея состояла в том, чтобы вырезать любую ячейку, начинающуюся с "адреса" в новом столбце в той же позиции строки, и повторить ее для остальной информации, чтобы я получил новый лист с каждым столбцом, содержащим одинаковую информацию для всех строки.

Sub toto()
    lastligne = Sheets("sheet1").Range("A" & ASR.Rows.Count).End(xlUp).Row
    lastcolon = Sheets("sheet1").Range("A" & ASR.Rows.Count).End(xlUp).Column
    For NoLig = 2 To lastligne
        For NoCol = 1 To 30
            If Left(Sheets("Sheet1").Cells(NoLig, NoCol).Value, 1) = "d" Then 
                Sheets("Sheet2").Cells(NoLig, 7) = Sheets("Sheet1").Cells(NoLig, NoCol).Value
            end If
        Next NoCol
    Next NoLig
End Sub

У меня есть объект требуется ошибка: run time error '424'

1 Ответ

0 голосов
/ 08 июля 2019
  1. Использование Option Explicit.Это заставит вас объявлять переменные / объекты.
  2. Определять объекты и работать с ними легко.

Это то, что вы связываете?( Не проверено )

Option Explicit

Sub toto()
    Dim ws As Worksheet
    Dim lastligne As Long, lastcolon As Long
    Dim NoLig As Long, NoCol As Long

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find last row in Col A
        lastligne = .Range("A" & .Rows.Count).End(xlUp).Row
        '~~> Find last column in Row 1
        lastcolon = .Cells(1, Columns.Count).End(xlToLeft).Column

        For NoLig = 2 To lastligne
            For NoCol = 1 To lastcolon
                If Left(.Cells(NoLig, NoCol).Value, 1) = "d" Then
                    Sheets("Sheet2").Cells(NoLig, 7) = .Cells(NoLig, NoCol).Value
                End If
            Next NoCol
        Next NoLig
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...