Вопрос № 112695: Имею код, который выводит уникальные значения из диапазона. Как можно дополнить код чтобы данные выходили уже отсортированные по алфавиту?
Спасибо
Public Sub GetUniqueValue()
With ThisWorkbook.Worksheets(1)
Dim iSource As ...Вопрос № 112844: Помогите пожалуйста. Мне нужно в Excel создать макрос, привязав его к командной кнопке, который в тексте будет подсчитывать кол-во слов в предложениях, в которых кол-во символов меньше 40.(при нажатии на кнопку должен появляться MsgBox - введите номе...
Вопрос № 112.695
Имею код, который выводит уникальные значения из диапазона. Как можно дополнить код чтобы данные выходили уже отсортированные по алфавиту?
Спасибо
Public Sub GetUniqueValue()
With ThisWorkbook.Worksheets(1)
Dim iSource As Range, iCell As Range
Set iSource = .Range("C2:D280")
With CreateObject("Scripting.Dictionary")
For Each iCell In iSource
iText$ = CStr(iCell.Value)
If Not .Exists(iText$) Then .Add iText$, iText$
Next
iItems = Application.Transpose(.Items)
End With
With .Range("J2").Resize(UBound(iItems))
.EntireColumn.Clear
.Value = iItems
End With
End With
End Sub
Отправлен: 06.12.2007, 20:55
Вопрос задал: Doubter (статус: Посетитель)
Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)
Отвечает: Тесленко Евгений Алексеевич
Здравствуйте, Doubter!
Если Вы прирастите к своему коду предлагаемый код сортировки с помощью ADODB.Recordset'а, задача будет выполнена.
Подключать библиотеку ADO не обязательно, закрывать рекордсет и очищать переменную обязательно (и не только по правилам хорошего тона:)
Евгений.
Отвечает: HookEst
Здравствуйте, Doubter!
Так как Вы выводите результат в Range так и выводите неотсортированные данные, а потом используйте Range.Sort.
Успехов.
p/s
Это не обязательно, просто как вариант
можно отказаться от промежуточного массива данных, а сразу писать в значения в цикле сразу после проверки на уникальность.
И от вызова Exists тоже можно отказаться, если заключить Add в On Error Resume Next и проверять Err, если ключа такого нет, то ошибки не будет, иначе Err<>0
примерно так:
Public Sub GetUniqueValue()
PrintUniqueValue Range("C2:D280"), Range("J2")
End Sub
Private Sub PrintUniqueValue(iSource As Range, aDst As Range)
Dim iCell As Range, iDst As Range
aDst.EntireColumn.Clear
Set iDst = aDst
With CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each iCell In iSource
.Add CStr(iCell), 0
If Err = 0 Then
iDst = iCell
Set iDst = iDst.Offset(1)
Else
Err.Clear
End If
Next
On Error GoTo 0
End With
Range(aDst, iDst.Offset(-1)).Sort key1:=aDst
End Sub
Ответ отправил: HookEst (статус: Студент)
Ответ отправлен: 07.12.2007, 07:52
Вопрос № 112.844
Помогите пожалуйста. Мне нужно в Excel создать макрос, привязав его к командной кнопке, который в тексте будет подсчитывать кол-во слов в предложениях, в которых кол-во символов меньше 40.(при нажатии на кнопку должен появляться MsgBox - введите номер предложения (вводим) потом выдается MsgBox - общее кол-во предложений и потом сколико слов в этом предложении, если кол-во символов в этом предложении больше 40, то MsgBox - в этом предложении болеше 40 символов.
Отправлен: 07.12.2007, 18:03
Вопрос задала: Atina (статус: Посетитель)
Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)
Отвечает: Черников Игорь Владимирович
Здравствуйте, Atina!
'Вы не сказали откуда будете брать данные, и я подумал, что из какого-то другого файла, т.к.
'в EXCEL в каждой ячейке можно напечатать не более 256 символов.
'Здесь данные беруться из текстового файла txt.txt, который нужно положить в корень диска C:
'Вот Ваша программа, надеюсь она Вам поможет.
Private Sub CommandButton1_Click()
Dim KolSimbol As Integer 'Обявляем переменные
Dim simbol As String
Dim ZadanPredl As Integer
On Error Resume Next 'Включаем обработчик ошибок, если он не нужен, эту строку можно убрать
10 ZadanPredl = InputBox("Введите предложения", "Ввод") 'Вводим нужную цифру
If Err.Number = 13 Then 'Обрабатываем ошибки, если не нужно, можно убрать до строки End If
MsgBox ("Можно вводить только цифры, повторите ввод")
Err.Clear
GoTo 10
End If
Open "C: xt.txt" For Input As #1 ' Открываем текстовый файл с текстом, если его нет, то нужно его создать и скопировать в него текст
If Err.Number = 53 Then 'Снова обрабатываем ошибки, если не нужно, можно убрать до строки End If
MsgBox ("Файл не найден, проверьте его наличие на диске С: xt.txt, файл он не должен быть скрытым!")
Err.Clear
End
End If
Do While Not EOF(1) 'Цикл до конца файла
simbol = Input(1, 1) 'Читаем из файла по одному символу
KolSimbol = KolSimbol + 1 'Считаем количество символов
If simbol <> " " Then FlagProbel = True 'Это для того, чтобы лишние пробелы между слов не посчитать как слова
If simbol = " " Then 'Если пробел, то... (Если слово кончилось то...)
If FlagProbel = True Then 'Если это не лишний пробел
KolSolv = KolSolv + 1 'Считаем количество слов в предложении
FlagProbel = False
End If
End If
If simbol = "." Then 'Если конец предложения
NumPredl = NumPredl + 1 'Считаем предложения
If ZadanPredl = NumPredl Then 'Если заданное предложение совпадает с прочитанным, то...
SlovVPredl = KolSolv
Simvolov = KolSimbol
End If
KolSolv = 0 'Обнуляем количество слов
KolSimbol = 0 'Обнуляем количество символов
End If
Loop 'Конец цикла
Close #1 'Закрываем открытый файл
Select Case Simvolov 'В зависимости от количества символов в предложении, выводим сообщение
'Пробел и перевод каретки на новую строку - тоже символы
Case 0 To 39
MsgBox ("Общее количество предложений - " & NumPredl & Chr(13) & Chr(10) & _
"Количество слов в предложении №" & ZadanPredl & " - " & SlovVPredl & Chr(13) & Chr(10) & _
"Количество символов в этом предложении меньше 40, т.е. " & Simvolov)
Case 40
MsgBox ("Общее количество предложений - " & NumPredl & Chr(13) & Chr(10) & _
"Количество слов в предложении №" & ZadanPredl & " - " & SlovVPredl & Chr(13) & Chr(10) & _
"Количество символов в этом предложении равно 40.")
Case Else
MsgBox ("Общее количество предложений - " & NumPredl & Chr(13) & Chr(10) & _
"Количество слов в предложении №" & ZadanPredl & " - " & SlovVPredl & Chr(13) & Chr(10) & _
"Количество символов в этом предложении больше 40 т.е. " & Simvolov)
End Select
End Sub
'Если не помогло, задайте вопрос ещё раз с уточнениями или пишите в личку 'Удачи!
--------- От каждого по способностям, каждому по труду
Ответ отправил: Черников Игорь Владимирович (статус: 8-ой класс)
Ответ отправлен: 08.12.2007, 12:52 Оценка за ответ: 5 Комментарий оценки: Большое спасибо - работает.
