Скопируйте значение переменной и вставьте его на другой лист.
то, что я пытаюсь сделать прямо сейчас, это взять диапазон (скажем, C: C), пройти через все ячейки со значением и вставить их в другую таблицу.
Моя цель – скопировать значение переменной (потому что я не знаю, сколько значений у меня было бы на C: C) и вставьте ее на другой лист, чтобы я мог иметь новый диапазон со всеми значениями (если бы не было повторяющиеся значения).
Как закодировать оператор If (для значений переменных).
- Excel VBA IF ElseIf
- VBA Actuarial Triangle Код If-Then-Else
- Excel вложенной If с COUNTIF и ISBLANK
- Excel «IF» «AND» не возвращает желаемый результат
- 4 столбца VLOOKUP в Excel
Если кто-нибудь может мне помочь, я буду благодарен. Это то, что я имею к этому вопросу:
Sub Test_1() ' Go through each cells in the range Dim rg As Range Dim copySheet As Worksheet Dim pasteSheet As Worksheet Set copySheet = Worksheets("Data") Set pasteSheet = Worksheets("Data_storage") For Each rg In Worksheets("Data").Range("C:C") If rg.Value = "Client 1" Then 'Instead of "Client 1" should be a variable value because "Client 1" will be a repetead value in C:C copySheet.Range("C2").Copy 'Starting the counter in C2 pasteSheet.cells(Row.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValue End If Next End Sub
- Excel VBA - Пропустить суб или конец под IF-заявлением
- Напишите «хороший» или «плохой», если значения в диапазоне истинны или ложны
- Как скомпилировать условное правило Excel 3-мерного масштаба
- Что использовать в качестве логической функции, отличной от If in excel
- Excel: подсчет данных для разных дней разных недель (количество переменных строк)
- Поиск даты в диапазоне дат в excel
- Используя формулу = IF (ISNA (формула VLOOKUP
- Есть ли более простой способ многократно вставлять строки в нижнюю часть списка?
принимая ваши значения в листе «Данные»:
-
находятся в столбце "C"
-
начать с строки 1, с "заголовком"
то вы можете попробовать этот код:
Option Explicit Sub Test_1() Dim sourceRng As Range, pasteRng As Range, cell As Range Set pasteRng = Worksheets("Data_storage").Range("A1") '<--| set the upper-left cell in "paste" sheet With Worksheets("Data") '<--| reference "source" sheet Set sourceRng = .Range("D1", .Cells(.Rows.Count, "C").End(xlUp)) '<--| set the "source" range to columns "C:D" from row 1 down to last non empty cell in column "C" End With With sourceRng '<--| reference "source" range .Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, header:=xlYes '<--| sort it by its column 1 and then by its column 2 pasteRng.Resize(.Rows.Count).value = .Resize(, 1).value '<--| paste its column 1 values to "Paste" sheet column 1 pasteRng.CurrentRegion.RemoveDuplicates Columns:=Array(1) '<--| leave only unique values in "paste" range Set pasteRng = pasteRng.Range(pasteRng.Offset(1), pasteRng.End(xlDown)) '<--| skip "paste" range header For Each cell In pasteRng '<--| loop through unique values in "paste" range column 1 .AutoFilter field:=1, Criteria1:=cell.value '<--| filter "source" range column 1 with current unique value .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "source" range" column 2 filtered cells cell.Offset(, 1).PasteSpecial Transpose:=True '<--| ... and paste/transpose them aside current unique value in "paste" range Next cell .Parent.AutoFilterMode = False '<--| .. show all rows back... End With End Sub
Если вы не хотите их сортировать, вы можете записать макрос примерно так:
-
Выберите столбец C
-
Главная ➤ Найти и выбрать ➤ Константы
http://www.contextures.com/images/formatformulas04.png -
Скопируйте и вставьте выделение на другой лист
-
Данные ➤ Удалить дубликаты
http://blog.contextures.com/wp-content/uploads/2009/12/removedups02.jpg
PS Я использовал № 3 отсюда :]
Словарь также может быть полезен, особенно если вы планируете более сложную фильтрацию или расчет:
Public Sub CopyUnique(rngSource As Range, rngDestinationFirst As Range) If rngSource Is Nothing Or rngSource.Worksheet.UsedRange Is Nothing Then Exit Sub End If Dim dctValues As Scripting.Dictionary: Set dctValues = New Scripting.Dictionary ' Requires Tools > References > Microsoft Scripting Runtime Dim rngSourceUsed As Range: Set rngSourceUsed = Application.Intersect(rngSource, rngSource.Worksheet.UsedRange) Dim varCell As Variant: For Each varCell In rngSourceUsed.Cells: Dim rngCell As Range: Set rngCell = varCell If dctValues.Exists(rngCell.Value) = False Then dctValues.Add varCell.Value, varCell.Value ' varCell.Formula may be also interesting depending on the business logic End If Next varCell Dim varValues() As Variant: ReDim varValues(0 To dctValues.Count - 1, 0 To 0) Dim i As Long: i = LBound(varValues, 1) Dim varValue As Variant: For Each varValue In dctValues.Keys varValues(i, 0) = varValue i = i + 1 Next varValue rngDestinationFirst.Resize(dctValues.Count, 1).Value = varValues End Sub Public Sub TestCopyUnique() CopyUnique ActiveSheet.Range("C:C"), Workbooks.Add(xlWBATWorksheet).Worksheets(1).Range("A1") End Sub