有人可以帮我修改这个 Excel VBA 代码吗？

Posted 2023-02-19

【中文标题】有人可以帮我修改这个 Excel VBA 代码吗？

【英文标题】：Can someone help me modify this Excel VBA code?

【发布时间】：2017-05-26 21:08:35

【问题描述】：

我有一个正在尝试编辑的 Excel 宏电子表格。这是一个清理器，用于清理用于处理数据的某些列中的字段。该代码是由以前的同事编写的。该文件可以在这里找到。

http://www.mediafire.com/file/luv3wsfhdvz20h7/Master_data_scrubber_-_USE_THIS_ONE.xlsm

Anways 我对 excel 比较陌生，而且我对 VBA 了解不多，所以在查看代码时，我对这一切都不太了解。我正在尝试编辑清洁宏。有一个 clean all 按钮，它将采用 Columns A-AP 并在其旁边创建一个带有已清理值的新列。每列还有单独的按钮清洁器。

B 列包含一个 sku 编号列 (I.G 40118)，清洁按钮将向其中添加制造商代码 (例如 happ)。因此，在按下 Clean 后，将在 B 和 C 之间插入一列。在这个新列中将是值 happ40118。

K 列标有图像名称。所以说 K2 中的值可能是“hungryhippos-box.jpg” 目前，列 K 的清理按钮只是复制值并将其粘贴到新插入列的单元格中。

我希望按钮实际上而不是复制值从 Cleaned_Sku 列（新创建的列 C）中的单元格中获取值，然后从列 K (.jpg) 的值中添加扩展名并将它们连接起来一起在新创建的 L 列中。所以值看起来像 happ40118.jpg。

代码如下所示。

**For the Clean All**

Private Sub Clean_ALL_Click()

MsgBox ("This action will take a few moments.")
Application.ScreenUpdating = False
 Cells.Select
    Range("AM9").Activate
    With Selection.Font
        .Name = "Arial"
        .Size = 8
    End With

Call CleanSKUs_Click
Call CleanBrand_Click
Call Clean_MFG_SKU_Click
Call Clean_UPC_Click
Call Clean_ISBN_Click
Call Clean_EAN_Click
Call Clean_product_name_Click
Call Clean_Short_desc_Click
Call Celan_long_desc_Click
Call Clean_Image_Click
Call Clean_MSRP_Click
Call Clean_Cost_Click
Call Clean_product_weight_Click
Call Clean_product_weight_u_Click
Call Clean_product_length_Click
Call Clean_product_width_Click
Call Clean_product_height_Click
Call Clean_product_lwh_uom_Click
Call Clean_age_range_Click
Call Clean_Origin_Click
Call Clean_origin_text_Click
Call Clean_Product_safety_Click
Call Clean_category_Click
Call Clean_Processed_date_Click
Call Clean_Interactive_URL_Click
Call Cleaned_Drop_ship_Click
Call Cleaned_Developmental_Attributes_Click
Call Clean_keywords_Click
Call Clean_product_available_date_Click
Call Clean_gender_Click
Call Clean_attribute_Click
Call Clean_products_Awards_Click
Call Clean_P_Awards_index_Click
Call Clean_Out_of_Production_Click
Application.ScreenUpdating = True
MsgBox ("The data cleaning is done!" & vbCrLf & vbCrLf & "  All the data has been copied to a new column," & vbCrLf & "check the data before using it.")

End Sub

----------
**For the Clean SKU** 

Private Sub CleanSKUs_Click()

 Dim a$, b$, C$, prefix$, count$, MyLetter$, number, ii, j, I As Integer
 Dim lr As Long
 Dim r As Range
 Dim popbox As String
 Dim popcount, loopI As Integer

 For intCounter = 1 To ActiveSheet.UsedRange.Columns.count
    count$ = Cells(1, intCounter).Address(False, False)
    Range(count$).Select
    If ActiveCell.Value = "SKU" Then
      number = intCounter
      ActiveCell.Offset(0, 1).EntireColumn.Insert
      ActiveCell.Offset(0, 1).Value = "Cleaned SKUs"
    Exit For
    End If
 Next intCounter

ii = number / 26
 If ii > 1 Then
   ii = Int(ii)
   j = ii * 26
   If number = j Then
     number = 26
     ii = ii - 1
   Else
     number = number - j
   End If
   MyLetter = ChrW(ii + 64)
 End If

 MyLetter$ = MyLetter$ & ChrW(number + 64)
 lr = Cells(Rows.count, "B").End(xlUp).Row 'find Last row

 Set r = Range(MyLetter$ & "2:" & MyLetter$ & lr) 'define working range

 Sheets("VARs").Activate
 ActiveSheet.Cells(3, 2).Select
 prefix$ = Selection.Value
 Sheets("NewData").Activate

 Dim d
 Set d = CreateObject("Scripting.Dictionary")
 popcount = 0
 loopI = 1

 For Each cell In r

 loopI = loopI + 1
 If d.Exists(cell.Value) Then
    ' tag the d(cell.value) row   -- i.e. (the first appearance of this SKU)
    Rows(d(cell.Value) & ":" & d(cell.Value)).Select
    Selection.Interior.ColorIndex = 6
    ' tag the row
    Rows(loopI & ":" & loopI).Select
    Selection.Interior.ColorIndex = 6
    ' add duplicate to popup box
    popcount = popcount + 1
 Else
    d.Add cell.Value, loopI
 End If

 a$ = cell.Value
 For I = 1 To Len(a$)
 b$ = Mid(a$, I, 1)
 If b$ Like "[A-Z,a-z,0-9]" Then
 C$ = C$ & b$
 End If
 Next I
 C$ = prefix$ & C$
 cell.Offset(0, 1).Value = LCase(C$) 'set value
 C$ = "" 'reset c$ to nothing
 Next cell

 If popcount > 0 Then
 MsgBox ("There were " & popcount & " repeated SKUs.")
 End If

End Sub

----------
***For the Clean Image(This is the one I want to modify)**

Private Sub Clean_Image_Click()

 Dim a$, b$, C$, count$, MyLetter$, number, ii, j, I As Integer
 Dim lr As Long
 Dim r As Range

 For intCounter = 1 To ActiveSheet.UsedRange.Columns.count
    count$ = Cells(1, intCounter).Address(False, False)
    Range(count$).Select
    If ActiveCell.Value = "Image filename" Then
      number = intCounter
      ActiveCell.Offset(0, 1).EntireColumn.Insert
      ActiveCell.Offset(0, 1).FormulaR1C1 = "Cleaned Image Filename"
    Exit For
    End If
 Next

ii = number / 26
 If ii > 1 Then
   ii = Int(ii)
   j = ii * 26
   If number = j Then
     number = 26
     ii = ii - 1
   Else
     number = number - j
   End If
   MyLetter = ChrW(ii + 64)
 End If

 MyLetter$ = MyLetter$ & ChrW(number + 64)
 lr = Cells(Rows.count, "B").End(xlUp).Row 'find Last row
 Set r = Range(MyLetter$ & "2:" & MyLetter$ & lr) 'define working range

 For Each cell In r
 a$ = cell.Value
 a$ = Trim(a$)
 cell.Offset(0, 1).Value = a$ 'set value
 a$ = "" 'reset c$ to nothing
 Next cell

End Sub

谢谢

【问题讨论】：

好的，第一件事。大多数人会责备您并告诉您 SO 不是代码编写服务。当你展示一个有问题的代码时，你并没有说你为实现它做了什么。同时，我有点喜欢这种任务，所以请看下文。

【参考方案1】：

首先，Clean_Image 例程要求 Clean_SKU 例程已经运行。它们在 Clean_all 例程中的顺序正确，但由于它们可以单独运行，所以我添加了一些代码以确保除非干净的 sku 已经这样做，否则干净的图像不会尝试运行。

在第一个 intCounter 循环和“ii= number”行之间添加它注意我在第一个 intCounter 循环之后说。完成后会有两个循环，一个是找到“图像文件名”列，然后是新的一个循环来获取清理后的 SKU 列。

'This section will find the column that the new Cleaned SKU value is in.  If it's not there, the procedure aborts.
 For intCounter = 1 To ActiveSheet.UsedRange.Columns.count
    count$ = Cells(1, intCounter).Address(False, False)
    Range(count$).Select
    If ActiveCell.Value = "Cleaned SKU" Then
      SKUColumn = intCounter
      Exit For
    End If

    If SKUColumn = 0 Then
        MsgBox "You must run the Clean SKUs program first.", vbOKOnly + vbCritical
        Exit Sub
    End If
 Next intCounter

现在，您需要找到图像扩展名和 sku 以创建新的图像文件名。我添加了一些比 a$、b$ 等更容易阅读的变量（哦，是的，Dim Statements...）将顶部更改为：

 Dim a$, b$, c$, SKUValue$, ImageExtension$, count$, MyLetter$, number, ii, j, I As Integer
 Dim lr As Long, SKUColumn As Long, ImageRow As Long
 Dim r As Range, cl As Range

我们稍后会详细讨论 DIM 语句。

'I didn't analyze this or try to change it, but I think it's a bit odd
 MyLetter$ = MyLetter$ & ChrW(number + 64)
 lr = Cells(Rows.count, "B").End(xlUp).Row 'find Last row
 Set r = Range(MyLetter$ & "2:" & MyLetter$ & lr) 'define working range

 'I changed 'cell' to 'cl' because cell is a reserved word, but in this instance is being used as a variable
 'and that's confusing
 For Each cl In r
  'take the file extension from the file name (maybe it's always .jpg, and maybe it isn't.
    ImageExtension = Right(cl.Value, 4)
    'get the row number we're on
    ImageRow = cl.Row
    'and get the SKU value from the Cleaned SKU column
    SKUValue$ = Trim(ActiveSheet.Cells(ImageRow, SKUColumn)) 'get the cleaned SKU
    'put them together in the new column
    cl.Offset(0, 1).Value = SKUValue & ImageExtension
  Next cl

这应该可行。

现在，关于 DIM 语句。它们实际上并不像你想象的那样工作。 a$、b$、c$ 部分确实创建了字符串变量，因为 '$'，但 'number' ii 和 j 不是数字，它们是变体。每个变量都必须明确地给出它的日期类型，或者它们默认为变量。只有 I 是整数。

好的，请尝试这些更改，如果您有任何问题或有疑问，请发表评论。

【讨论】：

这是否意味着我必须修改整个工作表 3(NewData) 页面上的 DIM 语句才能正常工作？在这个聊天中，我只粘贴了部分代码。这不是整个代码行，因此我发送了一个链接。

我得再看一遍，但一般来说，只要有“DIM A, B, C as string”之类的语句，只有 C 是字符串。 A 和 B 是变体。有时这会导致意外行为。我尝试尽可能明确地标注所有变量。只需在多个变量标注的行中添加“作为字符串（或您需要的任何变量类型）。您可能应该在顶部添加“选项显式”，以确保所有使用的变量都正确标注。