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

时间：2017-01-11 22:14:07

标签： excel-vba vba excel

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

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

Anways我对excel相对较新，而且我对VBA了解不多，所以在查看代码时我并不了解其中的大部分内容。我试图编辑清洁宏。有一个干净的全部按钮，它将采用列A-AP并在其旁边创建一个带有清理值的新列。每列还有单独的按钮清洁剂。

B列包含一个sku编号栏（I.G 40118），清洁按钮将向其添加制造商代码（例如，开心）。因此，在按下Clean之后，将在B和C之间插入一列。在此新列中将为值happy40118。

列K标记为图像名称。所以说K2的价值可能是＆＃34; hungryhippos-box.jpg＆＃34;目前，列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

由于

1 个答案:

答案 0 :(得分：0)

首先，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创建新的图像文件名。我添加了一些比$，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 $ part会创建字符串变量，因为'$'，但'number'ii，而j不是数字，它们是变体。每个变量必须明确地给出它的日期类型，或者它们默认为变体。只有我是一个整数。

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

相关问题
最新问题