我正在学习口译,我想在同声传译期间继续使用 Excel 作为我的主要工具。我已经创建了一个 FILTER 函数,并找到了一个简单的 VBA 代码,它可以在我输入字母时过滤表格/词汇表中的一列并更改表格以显示结果(我使用了带有链接单元格的文本框)。
我遇到的问题是,我想在输入时过滤多语言词汇表的所有列,并且我需要 Excel 忽略重音符号 (ä、ü、ö、à…)。
想象一下一个简单的多列,用于表示不同语言的不同术语。
主题 | 德文 | 英语 | 法语 |
---|---|---|---|
经济 | 经济 | 经济 | 经济 |
经济 | 原基 | 资产 | 阿图 |
运动 | 鲁德恩 | 划船 | 阿维龙 |
运动 | 排球 | 排球 | 排球 |
运动 | 祖绍尔 | 观众 | 观众 |
运动 | 致意仪式 | 开幕式 | 开幕式 |
运动 | 奖章 | 奖牌 | 奖章 |
健康 | 健康 | 健康,福祉 | 安好 |
健康 | 施加影响 | 疫苗 | 疫苗 |
健康 | 克雷布斯 | 癌症 | 癌症 |
健康 | 纳德恩 | 针 | 艾吉耶 |
政治 | 部长 | 部长 | 部长 |
政治 | 签名 | 投标 | 优惠申请 |
运动 | 德国高等学校体育联盟 | 国际大学生体育联合会 | 国际大学体育联合会 |
任何帮助都将不胜感激,非常感谢。
如前所述,我使用了 FILTER 函数,并且已经能够使用它来过滤词汇表的所有列,但是我认为我需要使用 VBA 来解决过滤时的重音问题(ä、ü、ö、à…)。
筛选:
=FILTER(Glossary;ISNUMBER(SEARCH(F2;Glossar[Deutsch]))+
ISNUMBER(SEARCH(F2;Glossary[Englisch]));"no match")
VBA:
Private Sub TextBox1_Change()
Application.ScreenUpdating = False
ActiveSheet.ListObjects("Glossar").Range.AutoFilter Field:=2, _
Criteria1:= "*" & [B2] & "*", _
Operator:=xlFilterValues
Application.ScreenUpdating = True
End Sub
我知道上面的 VBA 代码只是搜索第二列,还无法弄清楚多列搜索。
4
最佳答案
2
在列表框中输入内容时筛选多个列
- 下载工作文件的副本。
工作表模块,例如Glossar(Glossar)
Option Explicit
Private Sub GlossarySearchBox_Change()
FilterByStrippedColumn_Change
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
JoinLanguageColumnsInStrippedColumn_Change Target
End Sub
标准模块,例如Module1
Option Explicit
' Assumptions:
' - The table is never empty.
' - There are at least 2 columns.
' - The last column is the Stripped column.
' - There are only Language columns between the first Language column (incl.)
' - and the Stripped column (excl.).
' Module-Level
' Constants
Private Const GLOSSARY_TABLE_NAME As String = "Glossar"
Private Const GLOSSARY_SEARCH_CELL_ADDRESS As String = "B2"
Private Const GLOSSARY_FIRST_LANGUAGE_COLUMN As Long = 2
Private Const DIACRITICAL_STRING As String = "àáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Private Const STRIPPED_STRING As String = "aaaaaaceeeeiiiinooooouuuuyy"
Private Const JOIN_DELIMITER As String = "\"
Private Const MINIMUM_CHARACTERS As Long = 2 ' minimally 1
' Variables
Private WasStrippedColumnPopulated As Boolean
' Shape Calls
Sub ClearSearchCell_Click()
ClearSearchCell
End Sub
Sub ClearStrippedColumn_Click()
ClearStrippedColumn
End Sub
Sub RebuildStrippedColumn_Click()
RebuildStrippedColumn
End Sub
' Event Calls
' Called by 'Worksheet_Change'
Sub JoinLanguageColumnsInStrippedColumn_Change(ByVal Target As Range)
Dim trg As Range: Set trg = Intersect(RefLanguageColumns, Target)
If trg Is Nothing Then Exit Sub
JoinLanguageColumnsInStrippedColumn trg
WasStrippedColumnPopulated = True
End Sub
' Called by 'SearchBox_Change'
Sub FilterByStrippedColumn_Change()
FilterByStrippedColumn
End Sub
' Private Functions
Private Function RefTable() As ListObject
Set RefTable = Glossar.ListObjects(GLOSSARY_TABLE_NAME)
End Function
Private Function RefLanguageColumns() As Range
With RefTable.DataBodyRange
Set RefLanguageColumns = _
.Resize(, .Columns.Count - GLOSSARY_FIRST_LANGUAGE_COLUMN) _
.Offset(, GLOSSARY_FIRST_LANGUAGE_COLUMN - 1)
End With
End Function
Private Function RefSearchCell() As Range
Set RefSearchCell = Glossar.Range(GLOSSARY_SEARCH_CELL_ADDRESS)
End Function
Private Function GetSearchString() As String
GetSearchString = LCase(CStr(RefSearchCell.Value))
End Function
' Private Subs
Private Sub ClearSearchCell()
RefSearchCell.Value = vbNullString ' triggers the SearchBox_Change event
End Sub
Private Sub ClearStrippedColumn()
Dim lo As ListObject: Set lo = RefTable
ClearTableFilters lo
With lo.DataBodyRange
.Columns(.Columns.Count).ClearContents
End With
WasStrippedColumnPopulated = False
End Sub
Private Sub RebuildStrippedColumn()
Dim lo As ListObject: Set lo = RefTable
ClearTableFilters lo
JoinLanguageColumnsInStrippedColumn lo.DataBodyRange
WasStrippedColumnPopulated = True
End Sub
Private Sub ClearTableFilters(ByVal lo As ListObject)
With lo
If .ShowAutoFilter Then ' is turned on
If .AutoFilter.FilterMode Then ' is auto-filtered
.AutoFilter.ShowAllData ' clear filters
End If
Else ' is turned off
.Range.AutoFilter ' turn on
End If
End With
End Sub
Private Sub FilterByStrippedColumn()
Application.ScreenUpdating = False
Dim lo As ListObject: Set lo = RefTable
ClearTableFilters lo
Dim SearchString As String: SearchString = GetSearchString
If Len(SearchString) >= MINIMUM_CHARACTERS Then
lo.Range.AutoFilter _
Field:=lo.ListColumns.Count, _
Criteria1:="*" & SearchString & "*"
End If
Application.ScreenUpdating = True
End Sub
Private Sub JoinLanguageColumnsInStrippedColumn(ByVal rg As Range)
Const PROC_TITLE As String = "Join Language Columns in Stripped Column"
Dim lrg As Range: Set lrg = Intersect(rg.EntireRow, RefLanguageColumns)
If lrg Is Nothing Then Exit Sub
Dim ColumnsCount As Long: ColumnsCount = lrg.Columns.Count
Dim DelLen As Long: DelLen = Len(JOIN_DELIMITER)
Dim arg As Range, aData() As Variant, r As Long, c As Long, Text As String
On Error Goto ClearError
Application.EnableEvents = False
For Each arg In lrg.Areas
aData = arg.Value
For r = 1 To UBound(aData, 1)
Text = vbNullString
For c = 1 To ColumnsCount
Text = Text & aData(r, c) & JOIN_DELIMITER
Next c
Text = Left(Text, Len(Text) - DelLen) ' remove trailing delimiter
StripDiacritics Text
aData(r, 1) = Text
Next r
arg.Columns(1).Offset(, ColumnsCount).Value = aData
Next arg
ProcExit:
On Error Resume Next
Application.EnableEvents = True
WasStrippedColumnPopulated = True
On Error GoTo 0
Exit Sub
ClearError:
MsgBox "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
& Err.Description, vbCritical, PROC_TITLE
Resume ProcExit
End Sub
Private Sub StripDiacritics(ByRef Text As String)
Text = LCase(Text)
Dim n As Long, MatchedCharPosition As Long, Char As String
For n = 1 To Len(Text)
Char = Mid(Text, n, 1)
MatchedCharPosition = InStr(DIACRITICAL_STRING, Char)
If MatchedCharPosition > 0 Then
Text = Replace(Text, _
Mid(DIACRITICAL_STRING, MatchedCharPosition, 1), _
Mid(STRIPPED_STRING, MatchedCharPosition, 1))
End If
Next n
End Sub
1
-
非常非常感谢您提供的详细帮助!非常感谢 😉
–
|
以下是不使用 VBA 并使用命名函数进行尝试的方法:
-
采用
-
中定义以下内容
姓名 | 参考 |
---|---|
acc_1 | ="ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ" |
acc_2 | ="ĀāĂ㥹ĆćĈĉĊċČčĎďĐđĒēĔĕĖėĘęĚěĜĝĞğĠġĢģĤĥĦħĨĩĪīĬĭĮįİıĴĵĶķĸĹĺĻļĽľĿŀŁłŃńŅņŇňʼnŊŋŌōŎŏŐőŒœŔŕŖŗŘřŚśŜŝŞşŠšŢţŤťŦŧŨũŪūŬŭŮůŰűŲųŴŵŶŷŸŹźŻżŽžſ" |
字符集 | =acc_1 & acc_2 |
reg_1 | ="aaaaaaaceeeeiiiienoooooouuuuypsaaaaaaaceeeeiiiienoooooouuuuypy" |
reg_2 | ="aaaaaaccccccccddddeeeeeeeeeegggggggghhhhiiiiiiiiiijjkkkllllllllllnnnnnnnnnoooooooorrrrrrssssssssttttttuuuuuuuuuuuuwwyyyzzzzzzs" |
reg_chars | =reg_1 & reg_2 |
访问控制表 | =LAMBDA(c, IFERROR(MID(reg_chars, FIND(c, acc_chars), 1), NA())) |
全部2reg | =LAMBDA(term, MAP(term, LAMBDA(term, REDUCE(term, MID(term, SEQUENCE(LEN(term)), 1), LAMBDA(acc,cur, IF(ISNA(acc2reg(cur)), acc, SUBSTITUTE(acc, cur, acc2reg(cur)))))))) |
然后all2reg
可以在工作簿中的任何位置使用 – 例如输入F2
:
=IFERROR(
FILTER(
Glossary,
MMULT(
--ISNUMBER(
SEARCH(all2reg(F2), all2reg(Glossary[[Deutsch]:[French]]))
),
SEQUENCE(COLUMNS(Glossary) - 1, , 1, 0)
)
),
"no match"
)
不使用名称管理器
- 替换搜索词和语言列中的重音字符
- 在所有语言列中搜索,并使用 MMULT 函数获取每行分组的结果
输入F2
:
=LET(
acc_1, "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ",
acc_2, "ĀāĂ㥹ĆćĈĉĊċČčĎďĐđĒēĔĕĖėĘęĚěĜĝĞğĠġĢģĤĥĦħĨĩĪīĬĭĮįİıĴĵĶķĸĹĺĻļĽľĿŀŁłŃńŅņŇňʼnŊŋŌōŎŏŐőŒœŔŕŖŗŘřŚśŜŝŞşŠšŢţŤťŦŧŨũŪūŬŭŮůŰűŲųŴŵŶŷŸŹźŻżŽžſ",
acc_chars, acc_1 & acc_2,
reg_1, "aaaaaaaceeeeiiiienoooooouuuuypsaaaaaaaceeeeiiiienoooooouuuuypy",
reg_2, "aaaaaaccccccccddddeeeeeeeeeegggggggghhhhiiiiiiiiiijjkkkllllllllllnnnnnnnnnoooooooorrrrrrssssssssttttttuuuuuuuuuuuuwwyyyzzzzzzs",
reg_chars, reg_1 & reg_2,
acc2reg, LAMBDA(c, IFERROR(MID(reg_chars, FIND(c, acc_chars), 1), NA())),
all2reg, LAMBDA(term,
MAP(
term,
LAMBDA(term,
REDUCE(
term,
MID(term, SEQUENCE(LEN(term)), 1),
LAMBDA(acc, cur, IF(ISNA(acc2reg(cur)), acc, SUBSTITUTE(acc, cur, acc2reg(cur))))
)
)
)
),
IFERROR(
FILTER(
Glossary,
MMULT(
--ISNUMBER(SEARCH(all2reg(F2), all2reg(Glossary[[Deutsch]:[French]]))),
SEQUENCE(COLUMNS(Glossary) - 1, , 1, 0)
)
),
"no match"
)
)
- 如果您的列表很长且很多,按照克里斯尼尔森 (chris neilsen)的建议添加辅助列可能会提高性能。
6
-
我要感谢你的帮助。现在我有两种不同的方法来解决我的问题 🙂
– -
能否上传包含第一个解决方案的 Excel 工作簿?我发现您的解决方案更符合我的需求,但是对于给您
t quite seem to make it work. I immediatly get 0 or "no match". I
带来的不便,我深表歉意。
– -
我已经下载了文件。我会查找我做错了什么。谢谢。
– -
仍然无法解决
t really say what is wrong with my excel sheet when I do it, but I
(我经常在重新打开文件后收到有关损坏的消息)。再次感谢您的宝贵帮助。我真的很感激。
– -
不是很大,大约有 135 个输入的术语,分为三列(德语、英语、法语)。我将这些术语发布到您的文件中,它运行正常。这一定是我的问题。
–
|
–
–
Submit
,按Copy
并将其粘贴到您的帖子(问题)中。–
–
|