Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/25.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
有人能帮我修改这个Excel VBA代码吗?_Excel_Vba - Fatal编程技术网

有人能帮我修改这个Excel VBA代码吗?

有人能帮我修改这个Excel VBA代码吗?,excel,vba,Excel,Vba,我有一个excel宏电子表格,我正试图编辑它。这是一个清理器,用于清理用于处理数据的特定列中的字段。代码是由以前的同事编写的。文件可以在这里找到 另外,我对excel比较陌生,我对VBA了解不多,所以在查看代码时,我对所有内容都不太了解。我正在尝试编辑清理宏。有一个clean all按钮,它将获取a-AP列,并在旁边创建一个新列,其中包含已清除的值。每列还有单独的按钮清理器 B列包含sku编号列(I.G.40118),清洁按钮将向其添加制造商代码(I.G.happ)。因此,按下Clean键后,

我有一个excel宏电子表格,我正试图编辑它。这是一个清理器,用于清理用于处理数据的特定列中的字段。代码是由以前的同事编写的。文件可以在这里找到

另外,我对excel比较陌生,我对VBA了解不多,所以在查看代码时,我对所有内容都不太了解。我正在尝试编辑清理宏。有一个clean all按钮,它将获取a-AP列,并在旁边创建一个新列,其中包含已清除的值。每列还有单独的按钮清理器

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

列K标记为图像名称。因此,假设K2中的值可能是“hungryhippos box.jpg”。当前,列K的clean按钮只是复制值,然后将其粘贴到新插入列的单元格中

我希望按钮实际上不是复制值,而是从清除的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

谢谢

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

在第一个intCounter循环和我在第一个intCounter循环之后说的“ii=number”行之间加上这个。完成后将有两个循环,一个用于查找“图像文件名”列,另一个用于获取已清理的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语句…),将顶部更改为:

 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
稍后我们将讨论更多关于模糊陈述的内容

'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
这应该行得通

现在,关于模糊的陈述。它们实际上并不像你想象的那样有效。 a$、b$、c$部分确实会创建字符串变量,因为“$”,但“number”ii和j不是数字,它们是变量。每个变量都必须显式指定其日期类型,或者默认为variant。只有I是整数


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

好的,首先要做的事。大多数人会批评您,并告诉您,这不是一项代码编写服务。当您向代码提出问题时,您并没有说您为实现问题做了什么。同时,我也有点喜欢这种服务任务,请参见下文。这是否意味着我必须修改整个第3页(NewData)页面上的DIM语句才能正常工作?在本次聊天中,我只粘贴了部分代码。这不是整个代码行,因此我发送了一个链接。我将不得不再次查看它,但一般来说,只要有诸如“DIM a,B,C作为字符串”之类的语句,我都会在其中粘贴,只有C是字符串。A和B是变体。有时,这会导致意外行为。我试图尽可能明确地标注所有变量。只需在多个变量被标注的行中添加“作为字符串(或任何您需要的变量类型)。您可能应该在顶部添加“Option Explicit”,以确保所有使用的变量都被正确标注。