VBA найти значение и поместить его в определенную колонку
str.casefold рекомендуется для сопоставления строк без учета регистра. Решение @ nmichaels может быть адаптировано тривиально.
Используйте либо:
if 'MICHAEL89'.casefold() in (name.casefold() for name in USERNAMES):
Или:
if 'MICHAEL89'.casefold() in map(str.casefold, USERNAMES):
В соответствии с docs :
Casefolding похож на нижний, но более агрессивный, поскольку он предназначен для удаления всех различий в строках в строке. Например, немецкая строчная буква «ß» эквивалентна «ss». Так как это уже строчный регистр,
lower()ничего не сделает для «ß»;casefold()преобразует его в «ss».
2 ответа
Мой подход к задаче
Процедура находит диапазон данных, проходит через его значения, добавляет уникальные значения в словарь с суммой для определенной строки, а затем загружает все эти значения вместе с суммами на строку.
Option Explicit
Sub CountStuff()
Dim wb As Workbook, ws As Worksheet
Dim lColumn As Long, lRow As Long, lColTotal As Long
Dim i As Long, j As Long
Dim rngData As Range, iCell As Range
Dim dictVal As Object
Dim vArr(), vArrSub(), vArrEmpt()
'Your workbook
Set wb = ThisWorkbook
'Set wb = Workbooks("Workbook1")
'Your worksheet
Set ws = ActiveSheet
'Set ws = wb.Worksheets("Sheet1")
'Number of the first data range column
lColumn = ws.Rows(1).Find("1", , xlValues, xlWhole).Column
'Number of the last row of data range
lRow = ws.Cells(ws.Rows.Count, lColumn).End(xlUp).Row
'Total number of data range columns
lColTotal = ws.Cells(1, lColumn).End(xlToRight).Column - lColumn + 1
'Data range itself
Set rngData = ws.Cells(1, lColumn).Resize(lRow, lColTotal)
'Creating a dictionary
Set dictVal = CreateObject("Scripting.Dictionary")
'Data values -> array
vArr = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1, _
rngData.Columns.Count).Value
'Empty array
ReDim vArrEmpt(1 To UBound(vArr, 1))
'Loop through all values
For i = LBound(vArr, 1) To UBound(vArr, 1)
For j = LBound(vArr, 2) To UBound(vArr, 2)
'Value is not numeric and is not in dictionary
If Not IsNumeric(vArr(i, j)) And _
Not dictVal.Exists(vArr(i, j)) Then
'Add value to dictionary
dictVal.Add vArr(i, j), vArrEmpt
vArrSub = dictVal(vArr(i, j))
vArrSub(i) = vArr(i, j - 1)
dictVal(vArr(i, j)) = vArrSub
'Value is not numeric but already exists
ElseIf dictVal.Exists(vArr(i, j)) Then
vArrSub = dictVal(vArr(i, j))
vArrSub(i) = vArrSub(i) + vArr(i, j - 1)
dictVal(vArr(i, j)) = vArrSub
End If
Next j
Next i
'Define new range for results
Set rngData = ws.Cells(1, lColumn + lColTotal - 1). _
Offset(0, 2).Resize(1, dictVal.Count)
'Load results
rngData.Value = dictVal.Keys
For Each iCell In rngData.Cells
iCell.Offset(1, 0).Resize(lRow - 1).Value _
= Application.Transpose(dictVal(iCell.Value))
Next
End Sub
Я использовал простую пользовательскую функцию, возможно, излишне, поскольку это можно было бы сделать с помощью формул листа, но учитывая, что ваши диапазоны могут меняться в любом направлении ...
Function altsum(r As Range, v As Variant) As Variant
Dim c As Long
For c = 2 To r.Columns.Count Step 2
If r.Cells(c) = v Then altsum = altsum + r.Cells(c - 1)
Next c
If altsum = 0 Then altsum = vbNullString
End Function
Пример ниже, скопируйте и формулу в F2 поперек и вниз (или применять его один раз с другим битом кода).
-
1
vArrSubявляется одномерным массивом всех SUM для каждой строки (i- это число строк),vArr- массив целых данных. Он просто перезаписывает номер SUM для этой строки с текущим SUM этого ключевого слова в этой строке. Я не знаю, как объяснить ^^ ' – AntiDrondert 19 July 2018 в 10:14