Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
FuMerOK
0 / 0 / 0
Регистрация: 15.04.2010
Сообщений: 16
1

Сформировать строку с брендами, но так чтобы они не повторялись

28.04.2015, 11:42. Просмотров 336. Ответов 10
Метки нет (Все метки)

Добрый день, столкнулся с такой проблемой, необходимо сформировать строку с брендами, но так чтобы они не повторялись и были определенной верхней категории (категория вначале которой стоит знак "!"), вот что получилось, но к сожалению работает не совсем корректно, вытаскивает не все бренды и категории, помогите разобраться в чем проблема, вот код
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
i = 5
k = 3
For Each c In Range("C3:C33000").Cells
    If (c.Cells(1, 23).Value = "" And c.Cells(2, 23).Value = "" And c.Cells(3, 23).Value = "") Then
        cell_value = c.Value
        'MsgBox ("Категория: " & cell_value)
        c.Cells(k, 13).Value = cell_value
        c.Cells(k + 1, 13).Value = "!!Брэнд"
        Do While c.Cells(i - 1, 23).Value <> "" And c.Cells(i, 23).Value <> "" And c.Cells(i + 1, 23).Value <> ""
            cell_value2 = c.Cells(i - 1, 23).Value
            c.Cells(k + 2, 13).Value = cell_value2
            k = k + 1
            'MsgBox ("Брэнд: " & cell_value2)
            While c.Cells(i - 1, 23).Value = cell_value2
                i = i + 1
            Wend
            
        Loop
    End If
Next
0
Вложения
Тип файла: zip price.zip (115.0 Кб, 5 просмотров)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
28.04.2015, 11:42
Ответы с готовыми решениями:

Ввести в массив четыре случайные цифры, так чтобы они не повторялись
Привет! Подскажите как можно вводить в массив четыре случайные цифры и так чтобы они не...

Заполнить таблицу элементами так, чтобы они не повторялись по диагонали, горизонтали и вертикали
2 задача во вложениях, можете подсказать алгоритм или метод как это сделать? Пытался сам...

Раскидать цифры от 1 до N и чтобы они не повторялись
Здравствуйте. Подскажите пожалуйста, как можно с помощью Random раскдать значения к примеру от 1 до...

Генератор случайных значений, чтобы они не повторялись!
Добрый день форумчане, есть необходимость в генераторе случайных чисел, но вот пробовал...

Как выбрать элементы, чтобы они не повторялись?
Добрый вечер, я только учусь и передо мной поставили такую задачу вывести из таблицы только...

10
Hugo121
6394 / 2462 / 439
Регистрация: 19.10.2012
Сообщений: 7,320
28.04.2015, 12:15 2
Не вполне понял... Там всего 4 таких.
Вот это нужно?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub tt()
    Dim a, i&
    a = Split(CreateObject("Scripting.FileSystemObject").Getfile("C:\Downloads\price.csv").OpenasTextStream(1).ReadAll, vbNewLine)
    For i = 0 To UBound(a)
        If Left(a(i), 3) = ";;!" Then
            If Left(a(i), 4) <> ";;!!" Then
                MsgBox a(i)
            End If
        End If
    Next
End Sub
В каком виде "сформировать строку" вообще тёмный лес... Но можно продолжить этот код.
0
FuMerOK
0 / 0 / 0
Регистрация: 15.04.2010
Сообщений: 16
28.04.2015, 13:21  [ТС] 3
виноват, не так выразился, нужно сформировать из этих брендов столбец, его структура должна быть:

!Название категории первого уровня
!!Брэнд (это константа)
Наименование бренда
Наименование бренда
...

их всего 4 потому что выложил часть прайса, так там около 30к строк
0
Hugo121
6394 / 2462 / 439
Регистрация: 19.10.2012
Сообщений: 7,320
28.04.2015, 13:23 4
1. Сформировать где? Исходник - текстовый файл.
2. В каком виде формировать - не понятно. Покажите результат в файле (результат из того, что приложили выше).
0
28.04.2015, 13:23
FuMerOK
0 / 0 / 0
Регистрация: 15.04.2010
Сообщений: 16
28.04.2015, 13:30  [ТС] 5
где сформировать - без разницы, хоть в том же исходнике на пустом столбце

а результат у меня не получается, но должно выглядеть например так:

!КОМПЛЕКТУЮЩИЕ ДЛЯ КОМПЬЮТЕРОВ
!!Брэнд
AGESTAR
THERMALTAKE
ACCORD
AEROCOOL
...
!НОУТБУКИ
!!Брэнд
BELKIN
HAMA
KROMAX
...
0
Hugo121
6394 / 2462 / 439
Регистрация: 19.10.2012
Сообщений: 7,320
28.04.2015, 13:46 6
Такого
!!Брэнд
вообще в файле нет.
Есть
;;!КОМПЛЕКТУЮЩИЕ ДЛЯ КОМПЬЮТЕРОВ;;;;;;;;;;;;;;;;;;;;;;;
;;!!Аксессуары;;;;;;;;;;;;;;;;;;;;;;;
;;!!!Mobile Rack;;;;;;;;;;;;;;;;;;;;;;;
и далее да, можно вытянуть бренд
AGESTAR

т.е. так что ли нужно?:

!КОМПЛЕКТУЮЩИЕ ДЛЯ КОМПЬЮТЕРОВ
!!Аксессуары
!!!Mobile Rack
AGESTAR
!!!Внешний корпус для HDD
AGESTAR
THERMALTAKE
!!Блоки питания
!!!ATX
ACCORD
AEROCOOL
FSP
GIGABYTE
0
FuMerOK
0 / 0 / 0
Регистрация: 15.04.2010
Сообщений: 16
28.04.2015, 15:29  [ТС] 7
ну да, "!!Брэнд" нет, по этому я добавлял его после "!КОМПЛЕКТУЮЩИЕ ДЛЯ КОМПЬЮТЕРОВ", "!НОУТБУКИ", а уже потом пытался вытаскивать бренды, нужно в таком виде:

!КОМПЛЕКТУЮЩИЕ ДЛЯ КОМПЬЮТЕРОВ
!!Брэнд
AGESTAR
THERMALTAKE
ACCORD
AEROCOOL

т.е. вытаскивать все бренды категории с одним восклицательным знаком

Добавлено через 1 час 36 минут
ну или хотя бы так
!КОМПЛЕКТУЮЩИЕ ДЛЯ КОМПЬЮТЕРОВ
!!Аксессуары
!!!Mobile Rack
AGESTAR
!!!Внешний корпус для HDD
AGESTAR
THERMALTAKE
!!Блоки питания
!!!ATX
ACCORD
AEROCOOL
FSP
GIGABYTE

если невозможно сделать как пытаюсь =С
0
Hugo121
6394 / 2462 / 439
Регистрация: 19.10.2012
Сообщений: 7,320
28.04.2015, 23:19 8
Код для обработки данных активного листа (т.е. csv открыли Экселем, все бренды в одном столбце):
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Option Explicit
 
Sub tt()
    Dim a(), b(), c(), wb As Object, i&, ii&, col As Object, arr, el
    With ActiveSheet
        a = .UsedRange.Columns(1).Value
        b = .UsedRange.Columns(3).Value
        c = .UsedRange.Columns(25).Value
    End With
    Set wb = Workbooks.Add(1)
    With wb.Sheets(1)
        On Error Resume Next
        For i = 1 To UBound(a)
            If Left(b(i, 1), 1) = "!" Then
                ii = ii + 1: .Cells(ii, 1) = b(i, 1)
            Else
                If IsNumeric(a(i, 1)) Then
                    Set col = New Collection
                    Do
                        If Left(b(i, 1), 1) = "!" Then i = i - 1: Exit Do
                        col.Add c(i, 1), c(i, 1)
                        i = i + 1
                    Loop
                    For Each el In col
                        ii = ii + 1
                        .Cells(ii, 1) = el
                    Next
                End If
            End If
        Next
    End With
End Sub
А вот этот код для обработки как текстового файла - но конкретно с этим прайсом не работает, т.к. там есть разделители внутри названий товаров, ктоб подсказал как обойти...
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
 
Sub tt()
    Dim a, wb As Object, i&, ii&, col As Object, arr, el
    a = Split(CreateObject("Scripting.FileSystemObject").Getfile("c:\Downloads\price.csv").OpenasTextStream(1).ReadAll, vbNewLine)
    Set wb = Workbooks.Add(1)
    With wb.Sheets(1)
        On Error Resume Next
        For i = 0 To UBound(a)
            If Left(a(i), 3) = ";;!" Then
                ii = ii + 1
                arr = Split(a(i), ";")
                .Cells(ii, 1) = arr(2)
            Else
                If IsNumeric(Split(a(i), ";")(0)) Then
                    Set col = New Collection
                    Do
                        If Left(a(i), 3) = ";;!" Then i = i - 1: Exit Do
                        arr = Split(a(i), ";")
                        col.Add arr(24), arr(24)
                        i = i + 1
                    Loop
                    For Each el In col
                        ii = ii + 1
                        .Cells(ii, 1) = el
                    Next
                End If
            End If
        Next
    End With
End Sub
0
FuMerOK
0 / 0 / 0
Регистрация: 15.04.2010
Сообщений: 16
29.04.2015, 00:24  [ТС] 9
огромное спасибо, как текстовый файл мне и не нужно обрабатывать)
0
Hugo121
6394 / 2462 / 439
Регистрация: 19.10.2012
Сообщений: 7,320
30.04.2015, 13:11 10
Вроде хотелось примерно так?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
 
Sub tt()
    Dim a(), b(), c(), wb As Object, i&, ii&, col As Object, arr, el
    With ActiveSheet
        a = .UsedRange.Columns(1).Value
        b = .UsedRange.Columns(3).Value
        c = .UsedRange.Columns(25).Value
    End With
    Set wb = Workbooks.Add(1)
    With wb.Sheets(1)
        On Error Resume Next
        For i = 1 To UBound(a)
            If Left(b(i, 1), 2) <> "!!" Then
                If Left(b(i, 1), 1) = "!" Then
                    ii = ii + 1: .Cells(ii, 1) = b(i, 1)
                Else
                    If IsNumeric(a(i, 1)) Then
                        Set col = New Collection
                        Do
                            If Left(b(i, 1), 2) <> "!!" Then
                                If Left(b(i, 1), 1) = "!" Then i = i - 1: Exit Do
                                col.Add c(i, 1), c(i, 1)
                            End If
                            i = i + 1
                        Loop
                        For Each el In col
                            ii = ii + 1
                            .Cells(ii, 1) = el
                        Next
                    End If
                End If
            End If
        Next
    End With
End Sub
1
FuMerOK
0 / 0 / 0
Регистрация: 15.04.2010
Сообщений: 16
30.04.2015, 13:28  [ТС] 11
спасибо, то что надо)
0
30.04.2015, 13:28
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
30.04.2015, 13:28

Расставить на поле 4х4 буквы ABCD так что бы они не повторялись ни в строке, ни в столбце
Добрый день! помогите в написаны игры. Суть игры : Нужно расставить на поле 4на4 буквы ABCD так...

Поставить два блока в одну строку, так чтобы они отстояли друг от друга на определенном растоянии
Ширина и высота не заданы, как поставить два блока в одну строку, так чтобы они отстояли друг от...

Как сделать так чтобы вопросы не повторялись?
Есть массив из 5-ти вопросов. Выбираются случайно 3. Как сделать так чтобы вопросы не повторялись?...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru