Макрос "дата"

[Vadim Lisovec]

Здравствуйте !
Нужна ваша помощь
Есть столбец в нем например(№ ПА 1456 и дата 15/06/99) имеет такой вид ПА 1456 15/06/99
то что подчеркнуто нужно оставить а дату перенести в соседний столбец ( итак для 3000 строк) помогите макросом
заранее спасибо !!!

[Hugo121]

Данные - текст по столбцам.
Можете записать рекордером, если уж так нетерпится макрос

Вот записал и чуть подправил:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 20.09.2013 by Hugo

    ActiveSheet.Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(7, 9), Array(8, 4)), TrailingMinusNumbers:= _
        True
    ActiveSheet.Columns(2).EntireColumn.AutoFit
End Sub

[Vadim Lisovec]

Я не понимаю в макросах и записях рекордером если бы знал то бы не просил о помощи ! Вы можете помочь с макросом буду очень вам признателен !

[Vadim Lisovec]

Спасибо за помощь
)

[Hugo121]

Ну почитайте уже что-нибудь...
Да и кажется помогали уже Вам с макросами - замените тот код на этот, те данные на эти.
Хотя не нужен тут вообще макрос!

[Vadim Lisovec]

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

Ну почитайте уже что-нибудь...
Да и кажется помогали уже Вам с макросами - замените тот код на этот, те данные на эти.
Хотя не нужен тут вообще макрос!

Не помогает посмотрите сами вот тут каталог http://www.fayloobmennik.net/3202089

[Hugo121]

Ну да, там не совсем как в примере.
Вернее совсем не так. Есть например и такое:
ПА1811 103/03/99
И такое
ПА 2727 Штогрин Ярема Титусович Музичні твори з текстом Пісенник "Щаслива мить": авторські
16/11/99 пісні та музика на слова поетів


Такое руками. Или макрос сложный, думаю за деньги. Я не буду делать, некогда сейчас.

[Watcher_1]

Данные типа ПА1811 103/03/99 скорее всего человеческая ошибка, если все это игнорировать то будет так...

Sub TextBox1_Click()
    On Error Resume Next
    i = 1
    myE = Sheets(1).Range("A" & Sheets(1).Rows.Count).End(xlUp).Row + 1
    Do
        i = i + 1
        
        Application.StatusBar = i
        DoEvents
        If i = myE Then Exit Do
        If InStr(1, Range("A" & i), "/") > 0 Then
            myB = Split(Trim(Range("A" & i)), " ")
            Range("B" & i) = CDate(myB(UBound(myB)))
            myB(UBound(myB)) = ""
            Range("A" & i) = Join(myB, " ")
        End If
    Loop
    On Error GoTo 0
    MsgBox "Макрос завершил свою работу!"
End Sub

[Hugo121]

Там внизу есть куча со сдвигом дат по столбцам, и вообще там внизу беспорядок.
Т.е. даты конечно переносятся, это сделано - но вся задача думаю не решена.
Хотя что просили - то сделано

[Watcher_1]

Пусть приводит данные в нормальный вид. Так сказать подгоняет под макрос