Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос: Сортировка данных в MS Excel Добавлено: 13.07.10 00:14  

Автор вопроса:  Mourat Boutry | ICQ: 490484 
Знающие люди, подскажите пожалуйста. А еще лучше приведите пример. Так как я совсем не знаю VBA.

У меня есть xls файл с двумя книгами. В одной пустая таблица, а в другой список (где-то 700 отелей). Нужно выудить нужную инфу из каждой строки и положить ее в соответствующую ячейку в таблице. Если кто-то может помочь с этим то вот файл http://pinkink.ru/data.xls .

Структура такая:
есть строка типа
ROYAL IMPERIAL SAN REMO ***** - 126 Corso Imperatrice 80, 18038 Sanremo


1, ROYAL IMPERIAL SAN REMO - это название отеля
2, ***** - это количество звезд
3, 126 - это количество комнат
4, Corso Imperatrice 80 - это адрес
5, 18038 - это почтовый индекс
6, Sanremo - это название города
Нужно разбить эту строку на составляющие и поместить в таблицу.

Заранее спасибо.

Ответить

  Ответы Всего ответов: 7  

Номер ответа: 1
Автор ответа:
 Eugy



Вопросов: 0
Ответов: 73
  Профиль | | #1 Добавлено: 13.07.10 05:11
Да легко...,
отправьте 10000 лир на короткий номер 911 :)
  1. Option Explicit
  2.  
  3. Private Type HOTL
  4.     naim As String
  5.     adrs As String
  6.     city As String
  7.     indx As Long
  8.     strs As Integer
  9.     roms As Integer '
  10. End Type
  11.  
  12. Sub macros1()
  13.  
  14. Dim w As Worksheet
  15. Dim r As Range
  16. Dim ht As HOTL
  17. Dim i As Integer
  18.  
  19. For Each w In Worksheets
  20.     w.Name = Trim(w.Name)
  21. Next
  22.  
  23. Set w = ThisWorkbook.Worksheets.Item("DB I = X")
  24. w.Columns(5).NumberFormat = "00000"
  25. i = 2
  26.  
  27. For Each r In ThisWorkbook.Worksheets.Item("BOOKING").Rows
  28.     If Not setHOTL(ht, r.Cells(, 1), r.Cells(, 2)) Then Exit For
  29.     w.Range("A" & i & ":F" & i) = Array(ht.naim, String(ht.strs, "*"), ht.roms, ht.adrs, ht.indx, ht.city)
  30.     i = i + 1
  31. Next
  32. End Sub
  33.  
  34.  
  35. Private Function setHOTL(sp As HOTL, s1 As String, s2 As String) As Boolean
  36. Dim ss As Variant
  37. Dim i As Integer
  38.     If s1 = vbNullString Then setHOTL = False: Exit Function
  39.     ss = Split(s1, "-")
  40.     If (UBound(ss)) Then sp.roms = Trim(ss(1))
  41.     s1 = ss(0)
  42.     sp.naim = Trim(Split(ss(0), "*")(0))
  43.     For i = 5 To 1 Step -1
  44.         If InStr(Len(sp.naim), s1, String(i, "*")) Then
  45.             sp.strs = i
  46.             Exit For
  47.         End If
  48.     Next
  49.     ss = Split(s2, ",")
  50.     Dim sx As String
  51.     i = UBound(ss)
  52.     If i Then
  53.         sx = Trim(ss(i))
  54.         sp.indx = Val(sx)
  55.         If sp.indx = 0 Then
  56.             sp.city = sx
  57.         Else
  58.             sp.city = Trim(Right(sx, Len(sx) - Len(sp.indx) - 1))
  59.         End If
  60.     End If
  61.     sp.adrs = ss(0) & IIf(i > 1, "," & ss(1), "")
  62.     setHOTL = True
  63. End Function

Ответить

Номер ответа: 2
Автор ответа:
 Mourat Boutry



ICQ: 490484 

Вопросов: 1
Ответов: 5
  Профиль | | #2 Добавлено: 13.07.10 13:48
Спасибо большое! 10 000 лир нету, а вот например 10 евро могу выслать, в знак признательности.

Ответить

Номер ответа: 3
Автор ответа:
 Mourat Boutry



ICQ: 490484 

Вопросов: 1
Ответов: 5
  Профиль | | #3 Добавлено: 13.07.10 13:51
Возник вопрос. В офисе 2007-2010, в каком месте можно макрос подключить? Не могу найти. У меня 2010й

Ответить

Номер ответа: 4
Автор ответа:
 Mourat Boutry



ICQ: 490484 

Вопросов: 1
Ответов: 5
  Профиль | | #4 Добавлено: 13.07.10 14:05
Нашел где. Попробую подключить

Ответить

Номер ответа: 5
Автор ответа:
 Mourat Boutry



ICQ: 490484 

Вопросов: 1
Ответов: 5
  Профиль | | #5 Добавлено: 13.07.10 14:20
http://s61.radikal.ru/i174/1007/f8/113000cad788.jpg
такая вот неприятность выскочила.. как решить?

Ответить

Номер ответа: 6
Автор ответа:
 Mourat Boutry



ICQ: 490484 

Вопросов: 1
Ответов: 5
  Профиль | | #6 Добавлено: 13.07.10 22:36
Все получилось! Спасибо большое

Ответить

Номер ответа: 7
Автор ответа:
 Eugy



Вопросов: 0
Ответов: 73
  Профиль | | #7 Добавлено: 15.07.10 01:30
Был вне зоны...
Увидел два-три бага, могут выскочить, если некоррект. данные в столбце адреса.
eugyx@yandex.ru

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам