主页 / coding / 问题

问题[excel](coding)

Martin Hope
Danny Coleiro
Asked: 2025-04-10 07:14:55 +0800 CST
  • 7

1）请在Excel应用程序中运行以下代码。

    Sub Macro1()
    
    'Delete all shapes if exists
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next i
    
    'Add a Rectangle
    With ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=20, Top:=20, Width:=200, Height:=120)
        .Name = "myRectangle"
    End With
    
    'Make some formatting to the myRectangle
    With ActiveSheet.Shapes("myRectangle")
       .Line.Visible = msoTrue
       .Line.ForeColor.RGB = vbBlue
       .Line.Weight = 5
       .Fill.UserPicture "https://upload.wikimedia.org/wikipedia/en/b/ba/Flag_of_Germany.svg"
    End With
    
    End Sub

2)请检查您的Excel 工作表中是否有以下矩形。

图片1

3)我正在寻找一个可以给我以下图片的宏。

正如您所理解的，我想在边界和旗帜之间留出一些空白。

图2

excel
Martin Hope
ozgn
Asked: 2025-04-10 05:25:26 +0800 CST
  • 6

我需要你的帮助来更改此图形代码的背景和侧边距。我该如何在图片中的示例格式中执行此操作？

Set EMAChart = Sheets("Parameters").ChartObjects.Add(Left:=Range("a18").Left, Width:=700, Top:=Range("a18").Top, Height:=500)
With EMAChart.Chart
   'EMA_A Grafik
    .Parent.Name = "EMA Chart"

    With .SeriesCollection.NewSeries
        .ChartType = xlLine
        .Values = Sheets("data").Range("e2:e" & numRows)
        .XValues = Sheets("data").Range("a2:a" & numRows)
        .Format.Line.Weight = 1
        .Border.ColorIndex = 1
        .Name = "Price"
    End With

    With .SeriesCollection.NewSeries
        .ChartType = xlLine
        .AxisGroup = xlPrimary
        .Values = Sheets("data").Range("h2:h" & numRows)
        .Name = "EMA_A"
        .Border.ColorIndex = 44
        .Format.Line.Weight = 1

    End With
    'EMA_B Grafik
    With .SeriesCollection.NewSeries
        .ChartType = xlLine
        .AxisGroup = xlPrimary
        .Values = Sheets("data").Range("ı2:ı" & numRows)
        .Name = "EMA_B"
        .Border.ColorIndex = 26
        .Format.Line.Weight = 1

    End With
    'EMA_c Grafik
    With .SeriesCollection.NewSeries
        .ChartType = xlLine
        .AxisGroup = xlPrimary
        .Values = Sheets("data").Range("j2:j" & numRows)
        .Name = "EMA_C"
        .Border.ColorIndex = 17
        .Format.Line.Weight = 1

    End With
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Price"
    .Axes(xlValue, xlPrimary).MaximumScale = WorksheetFunction.Max(Sheets("Data").Range("e2:e" & numRows))
    .Axes(xlValue, xlPrimary).MinimumScale = Int(WorksheetFunction.Min(Sheets("Data").Range("e2:e" & numRows)))
    .Legend.Position = xlLegendPositionBottom
    .SetElement (msoElementChartTitleAboveChart)
    .ChartTitle.Text = " "

End With

在此处输入图片描述

excel
Martin Hope
Eriknme
Asked: 2025-04-10 02:18:27 +0800 CST
  • 7

我试图通过 Sharepoint 打开一个文本文件来阅读，但一直收到错误消息（运行时 52 错误名称或数字）。

我在 strFile 行上收到调试错误：Open strFile For Input as #1

Dim FileToOpen as Variant
Dim sh as Worksheet
Dim strFile As String
    
    '-------Open Text file -------------
Set FileToOpen = Application.FileDialog(msoFileDialogFilePicker)

With FileToOpen
        .Filters.Clear
        .Filters.Add "Text Files", "*.tx*"
        .Title = "Browse to text File"
        .AllowMultiSelect = False
        .InitialFileName = "https:\\my.sharepoint.com\sites\THALI01\"
        If .Show = True Then
            strFile = .SelectedItems(1)
        End If
    End With

   '''-----reading lines on text file-----

 Open strFile For Input As #1
    Do Until Left(Oneline, 42) = "Mapping Definition Name: "
      Line Input #1, Oneline
      DoEvents
    Loop
    
        Acq = Trim(Mid(Oneline, 42, 30))
        sh.Range("B8") = Acq
 
End Sub
excel
Martin Hope
Michi
Asked: 2025-04-09 16:48:16 +0800 CST
  • 4
0 一个 B 碳 D 埃 F 格 哈 我
1 问题 1 第二季度 第三季度 第四季度 问5
2 产品 100 400 600 200 900
3 产品
4 问题 1 100
5 第二季度 300
6 第三季度 200
7 第四季度 -400
8 问5 700

在 中，Range H3:I8我想转置 中的值Range A1:F2。
对于转置，我使用这个公式TRANSPOSE(A1:F2)。

但是，我不知道如何将数字之间的差异计算纳入Range B2:F2以下转置公式中：

I4 = 100 - 0 = 100
I5 = 400-100 = 300
I6 = 600-400 = 200
I7 = 200-600 = -400
I8 = 900-200 = 700

你有什么想法吗？

注意：总是只有一行需要转置。

excel
Martin Hope
Stephan
Asked: 2025-04-08 17:58:49 +0800 CST
  • 6

我有一个给定的字符串“2023-1”，代表 2023 年第一季度。在 Excel 中我有一个公式：

=IF(AND($A2 => [value to calculate];$A2 <= "2023-1");$B2;0)

现在 [要计算的值] 应为值“2022-2”（始终是公式中第二个值的前四个季度（在本例中为 2023-1）。

更多示例：

  • 2023-4 应为 2023-1
  • 2023-3 应导致 2022-4
  • 2023-2 应导致 2022-3

等等。

我不想使用 VBA，只想使用 Excel 中的常规公式。有什么方法可以实现吗？

我已经尝试使用 TEXTBEFORE 和 TEXTAFTER 函数，并从字符串的第二部分减去 4。但之后我仍然需要做一些调整，例如，4-4 变成了 0，但它应该是 1（第一季度）。3-4 = -1，但它应该是上一年第四季度的数据。

有没有更好的解决方案来解决这个问题，而无需使用几个嵌套的 IF 语句？

excel
Martin Hope
spinjector
Asked: 2025-04-07 22:32:18 +0800 CST
  • 5

如果我创建一个 Excel VBA 用户表单，该表单动态生成可变数量的控件，我该如何确定表单的可用区域，以便我可以调整表单大小以适合控件？

下面附上了一张截图，后面是代码示例，但最后几行代码不起作用。

我可以为 UserForm_Initialize() 编写自己的自动调整大小代码，但如果找不到表单可用的宽度和高度，就无法实现。这总是会存在差异，这无疑包括边框、阴影、标题栏等的尺寸。

我确实知道 VBA 中各种测量尺度（例如像素、缇、英寸等）比较混乱。因此，如果任何答案指定了所使用的尺度，那将会很有帮助，这样我就可以调用正确的转换函数。

我确实找到了有关 VBA 坐标系的这篇帖子，它很有帮助，但它没有回答我的问题： https://www.reddit.com/r/vba/comments/1arzvx8/coordinate_systems_in_vba_userform_controls/

在此处输入图片描述

Private Sub UserForm_Initialize()
    
    Dim ctls        As MSForms.Controls
    Dim ctl         As MSForms.Control
    Dim coll        As VBA.Collection
    Dim ctlCount    As Integer
    Dim colCount    As Integer
    Dim x           As Single
    Dim y           As Single
    Dim w           As Single
    Dim h           As Single
    Dim i           As Integer
    
    'Settings.
    colCount = 5
    w = 24
    h = 24
    
    'Get the objects.
    Set ctls = Me.Controls
    Set coll = New VBA.Collection
    
    'Add the buttons to a collection.
    ctlCount = ctls.Count
    For i = 0 To ctlCount - 1
        For Each ctl In ctls
            If ctl.TabIndex = i Then
                coll.Add ctl
            End If
        Next
    Next
    
    'Align the buttons.
    i = 0
    Do
        If i < ctlCount Then
            y = y + 1
            Do
                x = x + 1
                If x <= colCount Then
                    i = i + 1
                    Set ctl = coll.Item(i)
                    ctl.Left = (x - 1) * w
                    ctl.Top = (y - 1) * h
                    ctl.Width = 24
                    ctl.Height = 24
                Else
                    Exit Do
                End If
            Loop
            x = 0
        Else
            Exit Do
        End If
    Loop
    
    'Adjust the form size.
    Me.Width = (x + 1) * w      '### This does not work. ###
    Me.Height = (y + 1) * h     '### This does not work. ###
    
End Sub
excel
Martin Hope
Shiela
Asked: 2025-04-05 20:49:04 +0800 CST
  • 6

我这里有 2 张表。一张表用于存放主要数据。另一张表用于存放“名队”条目。

Sheet1（故意留空——如果有空白也可以查看结果）

一个 乙 碳
姓名 添加日期 修改日期
安娜 2025 年 3 月 11 日 2025 年 3 月 18 日
小牛 2025 年 3 月 11 日 2025 年 3 月 12 日
丽莎 2025 年 3 月 14 日 2025 年 3 月 13 日
罗恩 2025 年 3 月 11 日 2025 年 3 月 14 日
玛丽 2025 年 3 月 12 日 2025 年 3 月 15 日
库尔特 2025 年 3 月 13 日 2025 年 3 月 17 日
2025 年 3 月 15 日
凯文 2025 年 3 月 16 日

工作表2

一个 乙
团队 姓名
露西 安娜
露西 小牛
彼得 丽莎
彼得 罗恩
诺里 玛丽
诺里 库尔特
卡尔 莫娜
卡尔 凯文

列表框：

错误的团队

我想选择来自 Sheet2 的团队。下面有一段代码，但会出现“类型不匹配”的错误。

在 ComboBox 更改期间调用 showList：

Sub showList()
    Dim ws As Worksheet, colList As Collection
    Dim arrData, arrList, i As Long, j As Long
    Dim targetTeam As Variant
    ' *** 
    Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")
    Dim arr: arr = ws2.Range("B1").CurrentRegion.Value
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(arr)
        dict(arr(i, 2)) = Empty
    Next
   ' ***

    Set colList = New Collection
    Set ws = Worksheets("Sheet1")
    arrData = ws.Range("A1:E" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row)
    For i = 2 To UBound(arrData)
            targetTeam = Application.VLookup((arrData(i, 2)), ws2.Range("B1").CurrentRegion.Value, -1, False)
                If dict.exists(arrData(i, 1)) And cmbTeam = targetTeam Then
                    colList.Add i, CStr(i)
                End If

    Next
    ReDim arrList(1 To colList.count + 1, 1 To UBound(arrData))
    For j = 1 To 5
        arrList(1, j) = arrData(1, j) ' header
        arrList(1, 4) = "Date Added Duration"
        arrList(1, 5) = "Date Modified Duration"
        For i = 1 To colList.count
                arrList(i + 1, j) = arrData(colList(i), j)
                    Dim dateA As Variant
                    Dim dateB As Variant
                    Dim dateC As Variant
                    Dim difference1 As Long
                    Dim difference2 As Long
                
                ' Assign values to the dates
                dateA = arrList(i + 1, 2)
                dateB = arrList(i + 1, 3)
                dateC = Format(Now, "m/d/yyyy")
                
                ' Calculate the difference in days
                difference1 = DateDiff("d", dateA, dateC) 'date today minus date added
                
                If Not dateA = "" Then
                    If difference1 > 1 Then
                    arrList(i + 1, 4) = difference1 & " days"
                    Else
                    arrList(i + 1, 4) = difference1 & " day"
                    End If
                Else
                    arrList(i + 1, 4) = "Missing"
                End If
                
                difference2 = DateDiff("d", dateB, dateC) 'date today minus date modified
                
                If Not dateB = "" Then
                    If difference2 > 1 Then
                    arrList(i + 1, 5) = difference2 & " days"
                    Else
                    arrList(i + 1, 5) = difference2 & " day"
                    End If
                Else
                    arrList(i + 1, 5) = "Missing"
                End If
        Next
    Next
    With Me.ListBox1
        .Clear
        .ColumnCount = UBound(arrData, 2)
        .list = arrList
    End With
End Sub

类型不匹配错误

错误代码

期望：

期望结果

excel
Martin Hope
Jun Wu 131
Asked: 2025-04-05 17:49:57 +0800 CST
  • 6

当我输入此代码时：

Public Sub main(ByRef wkb As Workbook)

我再也无法在宏对话框中看到名为 main 的宏。

但如果我在下面这样做，我就能看到它。

Public Sub main()

我很确定这是因为争论ByRef wkb As Workbook，但我看到其他人也这样做，而且没问题，所以不确定我在这里做错了什么？

谢谢！

excel